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