1 |
(make-package "COMPILER" :use '("LISP")) |
(make-package "COMPILER" :use '("LISP")) |
|
(in-package "SYSTEM") |
|
|
(defvar *command-args* nil) |
|
|
(in-package "USER") |
|
|
(in-package "LISP") |
|
|
|
|
2 |
(make-package "SLOOP" :use '("LISP")) |
(make-package "SLOOP" :use '("LISP")) |
3 |
(make-package "SERROR" :use '("LISP" "SLOOP")) |
(make-package "SERROR" :use '("LISP" "SLOOP")) |
4 |
(make-package "ANSI-LOOP" :use '("LISP")) |
(make-package "ANSI-LOOP" :use '("LISP")) |
5 |
(make-package "DEFPACKAGE" :use '("LISP")) |
(make-package "DEFPACKAGE" :use '("LISP")) |
6 |
(make-package "TK" :use '("LISP" "SLOOP")) |
(make-package "TK" :use '("LISP" "SLOOP")) |
7 |
|
|
8 |
(eval-when (load) |
(in-package "SYSTEM") |
9 |
(if (fboundp 'get-system-time-zone) |
(defvar *command-args* nil) |
|
(setf system:*default-time-zone* (get-system-time-zone)) |
|
|
(setf system:*default-time-zone* 6))) |
|
10 |
|
|
|
(in-package "USER") |
|
11 |
(progn |
(progn |
12 |
(system:init-system) (gbc t) |
(system:init-system) |
13 |
|
(gbc t) |
14 |
|
|
15 |
|
(in-package "USER") |
16 |
|
|
17 |
(load (concatenate 'string si::*system-directory* "../gcl-tk/tk-package.lsp")) |
(load (concatenate 'string si::*system-directory* "../gcl-tk/tk-package.lsp")) |
18 |
|
|
19 |
(or lisp::*link-array* |
(or lisp::*link-array* |
20 |
(setq lisp::*link-array* |
(setq lisp::*link-array* |
21 |
(make-array (ash 1 11) :element-type 'string-char :fill-pointer 0))) |
(make-array (ash 1 11) :element-type 'string-char :fill-pointer 0))) |
22 |
(si::use-fast-links t) |
(si::use-fast-links t) |
23 |
|
|
24 |
(setq compiler::*cmpinclude* "\"cmpinclude.h\"") |
(setq compiler::*cmpinclude* "\"cmpinclude.h\"") |
25 |
|
|
26 |
(load (concatenate 'string si::*system-directory* "../cmpnew/cmpmain.lsp")) |
(load (concatenate 'string si::*system-directory* "../cmpnew/cmpmain.lsp")) |
27 |
(gbc t) |
(gbc t) |
28 |
(load (concatenate 'string si::*system-directory* "../cmpnew/lfun_list.lsp")) |
(load (concatenate 'string si::*system-directory* "../cmpnew/lfun_list.lsp")) |
31 |
(gbc t) |
(gbc t) |
32 |
(load (concatenate 'string si::*system-directory* "../lsp/auto_new.lsp")) |
(load (concatenate 'string si::*system-directory* "../lsp/auto_new.lsp")) |
33 |
(gbc t) |
(gbc t) |
34 |
|
|
35 |
(when compiler::*cmpinclude-string* |
(when compiler::*cmpinclude-string* |
36 |
(with-open-file (st (concatenate 'string si::*system-directory* "../h/cmpinclude.h")) |
(with-open-file (st (concatenate 'string si::*system-directory* "../h/cmpinclude.h")) |
37 |
(let |
(let |
38 |
((tem (make-array (file-length st) :element-type 'standard-char |
((tem (make-array (file-length st) :element-type 'standard-char |
39 |
:static t))) |
:static t))) |
40 |
(if (si::fread tem 0 (length tem) st) |
(if (si::fread tem 0 (length tem) st) |
41 |
(setq compiler::*cmpinclude-string* tem))))) |
(setq compiler::*cmpinclude-string* tem))))) |
42 |
|
|
43 |
(setf (symbol-function 'si:clear-compiler-properties) |
(setf (symbol-function 'si:clear-compiler-properties) |
44 |
(symbol-function 'compiler::compiler-clear-compiler-properties)) |
(symbol-function 'compiler::compiler-clear-compiler-properties)) |
45 |
(setq system::*old-top-level* (symbol-function 'system:top-level)) |
(setq system::*old-top-level* (symbol-function 'system:top-level)) |
46 |
|
|
47 |
(defvar si::*lib-directory* (namestring "../")) |
(defvar si::*lib-directory* (namestring "../")) |
48 |
|
|
49 |
|
(defun system::gcl-top-level (&aux tem) |
50 |
|
(si::set-up-top-level) |
51 |
(defun system::gcl-top-level (&aux tem) |
|
52 |
(si::set-up-top-level) |
(if (si::get-command-arg "-compile") |
53 |
|
(let (;(system::*quit-tag* (cons nil nil)) |
54 |
(if (si::get-command-arg "-compile") |
;(system::*quit-tags* nil) (system::*break-level* '()) |
55 |
(let (;(system::*quit-tag* (cons nil nil)) |
;(system::*break-env* nil) (system::*ihs-base* 1) |
56 |
;(system::*quit-tags* nil) (system::*break-level* '()) |
;(system::*ihs-top* 1) (system::*current-ihs* 1) |
57 |
;(system::*break-env* nil) (system::*ihs-base* 1) |
(*break-enable* nil) result) |
58 |
;(system::*ihs-top* 1) (system::*current-ihs* 1) |
(setq result |
59 |
(*break-enable* nil) result) |
(system:error-set |
60 |
(setq result |
'(progn |
61 |
(system:error-set |
(compile-file |
62 |
'(progn |
(si::get-command-arg "-compile") |
63 |
(compile-file |
:output-file |
64 |
(si::get-command-arg "-compile") |
(or (si::get-command-arg "-o") |
65 |
:output-file |
(si::get-command-arg "-compile")) |
66 |
(or (si::get-command-arg "-o") |
:o-file |
67 |
(si::get-command-arg "-compile")) |
(cond ((equalp |
68 |
:o-file |
(si::get-command-arg "-o-file") |
69 |
(cond ((equalp |
"nil") nil) |
70 |
(si::get-command-arg "-o-file") |
((si::get-command-arg "-o-file" t)) |
71 |
"nil") nil) |
(t t)) |
72 |
((si::get-command-arg "-o-file" t)) |
:c-file (si::get-command-arg "-c-file" t) |
73 |
(t t)) |
:h-file (si::get-command-arg "-h-file" t) |
74 |
:c-file (si::get-command-arg "-c-file" t) |
:data-file (si::get-command-arg "-data-file" t) |
75 |
:h-file (si::get-command-arg "-h-file" t) |
:system-p (si::get-command-arg "-system-p" t))))) |
76 |
:data-file (si::get-command-arg "-data-file" t) |
(bye (if (or compiler::*error-p* (equal result '(nil))) 1 0)))) |
77 |
:system-p (si::get-command-arg "-system-p" t))))) |
(cond ((si::get-command-arg "-batch") |
78 |
(bye (if (or compiler::*error-p* (equal result '(nil))) 1 0)))) |
(setq si::*top-level-hook* 'bye)) |
79 |
(cond ((si::get-command-arg "-batch") |
((si::get-command-arg "-f")) |
80 |
(setq si::*top-level-hook* 'bye)) |
(t ;; if ANY header or license information is printed by the |
81 |
((si::get-command-arg "-f")) |
;; program, then the following License and Enhancement notice |
82 |
(t ;; if ANY header or license information is printed by the |
;; must be printed (see License). |
83 |
;; program, then the following License and Enhancement notice |
(format t "GCL (GNU Common Lisp) ~A~%~a~%~a~%~%~a~%" "@LI-VERS@" |
84 |
;; must be printed (see License). |
"Licensed under GNU Library General Public License" |
85 |
(format t "GCL (GNU Common Lisp) ~A~%~a~%~a~%~%~a~%" "DATE" |
"Contains Enhancements by W. Schelter" |
86 |
"Licensed under GNU Library General Public License" |
"Use (help) to get some basic information on how to use GCL."))) |
87 |
"Contains Enhancements by W. Schelter" |
(setq si::*ihs-top* 1) |
88 |
"Use (help) to get some basic information on how to use GCL."))) |
(in-package 'system::user) (incf system::*ihs-top* 2) |
89 |
(setq si::*ihs-top* 1) |
(funcall system::*old-top-level*)) |
90 |
(in-package 'system::user) (incf system::*ihs-top* 2) |
|
|
(funcall system::*old-top-level*)) |
|
|
|
|
91 |
(defun lisp-implementation-version nil (format nil "GCL-~a-~a" si::*gcl-major-version* si::*gcl-version*)) |
(defun lisp-implementation-version nil (format nil "GCL-~a-~a" si::*gcl-major-version* si::*gcl-version*)) |
92 |
|
|
93 |
(terpri) |
(terpri) |
94 |
(setq si:*inhibit-macro-special* t) |
(setq si:*inhibit-macro-special* t) |
95 |
(gbc t) (system:reset-gbc-count) |
(gbc t) (system:reset-gbc-count) |
96 |
|
|
97 |
(defun system:top-level nil (system::gcl-top-level)) |
(defun system:top-level nil (system::gcl-top-level)) |
98 |
|
|
99 |
|
(setq compiler::*default-c-file* nil) |
100 |
|
(setq compiler::*default-h-file* nil) |
101 |
|
(setq compiler::*default-data-file* nil) |
102 |
|
(setq compiler::*default-system-p* nil) |
103 |
|
(setq compiler::*keep-gaz* nil) |
104 |
|
|
105 |
(unintern 'system) |
(unintern 'system) |
106 |
(unintern 'lisp) |
(unintern 'lisp) |
107 |
(unintern 'compiler) |
(unintern 'compiler) |
108 |
(unintern 'user) |
(unintern 'user) |
109 |
|
(fmakunbound 'si::init-cmp-anon) |
110 |
|
|
111 |
|
(eval-when (load) |
112 |
|
(if (fboundp 'get-system-time-zone) |
113 |
|
(setf system:*default-time-zone* (get-system-time-zone)) |
114 |
|
(setf system:*default-time-zone* 6))) |
115 |
|
|
116 |
(if (fboundp 'si::user-init) (si::user-init)) |
(if (fboundp 'si::user-init) (si::user-init)) |
117 |
(si::set-up-top-level)) |
(si::set-up-top-level) |
118 |
; (in-package "USER") |
|
119 |
; (system:save-system "saved_gcl") (bye) |
(setq si::*gcl-version* @LI-MINVERS@ si::*gcl-major-version* @LI-MAJVERS@) |
120 |
|
(setq compiler::*cc* @LI-CC@) |
121 |
; |
(setq compiler::*ld* @LI-LD@) |
122 |
; FIXME Leave the following in until maxima 5.6 is replaced |
(setq compiler::*ld-libs* @LI-LD-LIBS@) |
123 |
; |
(setq compiler::*opt-three* @LI-OPT-THREE@) |
124 |
;system-init |
(setq compiler::*opt-two* @LI-OPT-TWO@) |
125 |
|
(setq compiler::*init-lsp* @LI-INIT-LSP@) |
126 |
|
|
127 |
|
t) |