1 | ;;; boot.lisp |
---|
2 | ;;; |
---|
3 | ;;; Copyright (C) 2003-2007 Peter Graves <peter@armedbear.org> |
---|
4 | ;;; $Id: boot.lisp 14796 2015-09-07 12:24:42Z ehuelsmann $ |
---|
5 | ;;; |
---|
6 | ;;; This program is free software; you can redistribute it and/or |
---|
7 | ;;; modify it under the terms of the GNU General Public License |
---|
8 | ;;; as published by the Free Software Foundation; either version 2 |
---|
9 | ;;; of the License, or (at your option) any later version. |
---|
10 | ;;; |
---|
11 | ;;; This program is distributed in the hope that it will be useful, |
---|
12 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
14 | ;;; GNU General Public License for more details. |
---|
15 | ;;; |
---|
16 | ;;; You should have received a copy of the GNU General Public License |
---|
17 | ;;; along with this program; if not, write to the Free Software |
---|
18 | ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. |
---|
19 | ;;; |
---|
20 | ;;; As a special exception, the copyright holders of this library give you |
---|
21 | ;;; permission to link this library with independent modules to produce an |
---|
22 | ;;; executable, regardless of the license terms of these independent |
---|
23 | ;;; modules, and to copy and distribute the resulting executable under |
---|
24 | ;;; terms of your choice, provided that you also meet, for each linked |
---|
25 | ;;; independent module, the terms and conditions of the license of that |
---|
26 | ;;; module. An independent module is a module which is not derived from |
---|
27 | ;;; or based on this library. If you modify this library, you may extend |
---|
28 | ;;; this exception to your version of the library, but you are not |
---|
29 | ;;; obligated to do so. If you do not wish to do so, delete this |
---|
30 | ;;; exception statement from your version. |
---|
31 | |
---|
32 | (sys:%in-package "SYSTEM") |
---|
33 | |
---|
34 | (setq *load-verbose* nil) |
---|
35 | (setq *autoload-verbose* nil) |
---|
36 | |
---|
37 | ;; Redefined in macros.lisp. |
---|
38 | (defmacro in-package (name) |
---|
39 | (list '%in-package (string name))) |
---|
40 | |
---|
41 | (defmacro lambda (lambda-list &rest body) |
---|
42 | (list 'function (list* 'lambda lambda-list body))) |
---|
43 | |
---|
44 | (defmacro named-lambda (name lambda-list &rest body) |
---|
45 | (list 'function (list* 'named-lambda name lambda-list body))) |
---|
46 | |
---|
47 | ;; Redefined in macros.lisp. |
---|
48 | (defmacro return (&optional result) |
---|
49 | (list 'return-from nil result)) |
---|
50 | |
---|
51 | ;; Redefined in precompiler.lisp. |
---|
52 | (defmacro defun (name lambda-list &rest body) |
---|
53 | (let ((block-name (fdefinition-block-name name))) |
---|
54 | (list '%defun |
---|
55 | (list 'quote name) |
---|
56 | (list 'lambda lambda-list (list* 'block block-name body))))) |
---|
57 | |
---|
58 | ;; Redefined in macros.lisp. |
---|
59 | (defmacro defconstant (name initial-value &optional docstring) |
---|
60 | (list '%defconstant (list 'quote name) initial-value docstring)) |
---|
61 | |
---|
62 | ;; Redefined in macros.lisp. |
---|
63 | (defmacro defparameter (name initial-value &optional docstring) |
---|
64 | (list '%defparameter (list 'quote name) initial-value docstring)) |
---|
65 | |
---|
66 | (defmacro declare (&rest ignored) nil) |
---|
67 | |
---|
68 | (in-package #:extensions) |
---|
69 | |
---|
70 | (export '(%car %cdr %cadr %caddr)) |
---|
71 | |
---|
72 | (defmacro %car (x) |
---|
73 | (list 'car (list 'truly-the 'cons x))) |
---|
74 | |
---|
75 | (defmacro %cdr (x) |
---|
76 | (list 'cdr (list 'truly-the 'cons x))) |
---|
77 | |
---|
78 | (defmacro %cadr (x) |
---|
79 | (list '%car (list '%cdr x))) |
---|
80 | |
---|
81 | (defmacro %caddr (x) |
---|
82 | (list '%car (list '%cdr (list '%cdr x)))) |
---|
83 | |
---|
84 | (in-package #:system) |
---|
85 | |
---|
86 | ;; Redefined in precompiler.lisp. |
---|
87 | (defun eval (form) |
---|
88 | (%eval form)) |
---|
89 | |
---|
90 | ;; Redefined in pprint.lisp. |
---|
91 | (defun terpri (&optional output-stream) |
---|
92 | (%terpri output-stream)) |
---|
93 | |
---|
94 | ;; Redefined in pprint.lisp. |
---|
95 | (defun fresh-line (&optional output-stream) |
---|
96 | (%fresh-line output-stream)) |
---|
97 | |
---|
98 | ;; Redefined in pprint.lisp. |
---|
99 | (defun write-char (character &optional output-stream) |
---|
100 | (%write-char character output-stream)) |
---|
101 | |
---|
102 | (in-package #:extensions) |
---|
103 | |
---|
104 | ;; Redefined in pprint.lisp. |
---|
105 | (defun charpos (stream) |
---|
106 | (sys::stream-charpos stream)) |
---|
107 | |
---|
108 | ;; Redefined in pprint.lisp. |
---|
109 | (defun (setf charpos) (new-value stream) |
---|
110 | (sys::stream-%set-charpos stream new-value)) |
---|
111 | |
---|
112 | (export 'charpos '#:extensions) |
---|
113 | |
---|
114 | ;; Redefined in precompiler.lisp. |
---|
115 | (defun precompile (name &optional definition) |
---|
116 | (declare (ignore name definition)) |
---|
117 | nil) |
---|
118 | |
---|
119 | (export 'precompile '#:extensions) |
---|
120 | |
---|
121 | (in-package #:system) |
---|
122 | |
---|
123 | (defun simple-format (destination control-string &rest args) |
---|
124 | (apply #'format destination control-string args)) |
---|
125 | |
---|
126 | (export 'simple-format '#:system) |
---|
127 | |
---|
128 | ;; INVOKE-DEBUGGER is redefined in debug.lisp. |
---|
129 | (defun invoke-debugger (condition) |
---|
130 | (sys::%format t "~A~%" condition) |
---|
131 | (ext:quit)) |
---|
132 | |
---|
133 | ;;Redefined in extensible-sequences.lisp |
---|
134 | (defun length (sequence) |
---|
135 | (%length sequence)) |
---|
136 | |
---|
137 | (defun elt (sequence index) |
---|
138 | (%elt sequence index)) |
---|
139 | |
---|
140 | (defun subseq (sequence start &optional end) |
---|
141 | (sys::%subseq sequence start end)) |
---|
142 | |
---|
143 | (defun reverse (sequence) |
---|
144 | (sys::%reverse sequence)) |
---|
145 | |
---|
146 | (defun nreverse (sequence) |
---|
147 | (sys::%nreverse sequence)) |
---|
148 | |
---|
149 | (load-system-file "autoloads-gen") |
---|
150 | (load-system-file "autoloads") |
---|
151 | (load-system-file "early-defuns") |
---|
152 | (load-system-file "backquote") |
---|
153 | (load-system-file "destructuring-bind") |
---|
154 | (load-system-file "defmacro") |
---|
155 | (load-system-file "setf") |
---|
156 | (load-system-file "fdefinition") |
---|
157 | (load-system-file "featurep") |
---|
158 | (load-system-file "read-conditional") |
---|
159 | (load-system-file "macros") |
---|
160 | |
---|
161 | ;; Redefined in package.lisp |
---|
162 | (defun make-package (package-name &key nicknames use) |
---|
163 | (%make-package package-name nicknames use)) |
---|
164 | |
---|
165 | (load-system-file "read-circle") |
---|
166 | |
---|
167 | (copy-readtable +standard-readtable+ *readtable*) |
---|
168 | |
---|
169 | ;; SYS::%COMPILE is redefined in precompiler.lisp. |
---|
170 | (defun sys::%compile (name definition) |
---|
171 | (values (if name name definition) nil nil)) |
---|
172 | |
---|
173 | (load-system-file "inline") |
---|
174 | (load-system-file "proclaim") |
---|
175 | (load-system-file "arrays") |
---|
176 | (load-system-file "compiler-macro") |
---|
177 | (load-system-file "subtypep") |
---|
178 | (load-system-file "typep") |
---|
179 | (load-system-file "signal") |
---|
180 | (load-system-file "list") |
---|
181 | (load-system-file "require") |
---|
182 | ;; precompiler has a large performance benefit on interpreted code |
---|
183 | ;; load as early as possible |
---|
184 | (load-system-file "precompiler") |
---|
185 | (load-system-file "extensible-sequences-base") |
---|
186 | (load-system-file "sequences") |
---|
187 | (load-system-file "error") |
---|
188 | (load-system-file "defpackage") |
---|
189 | (load-system-file "define-modify-macro") |
---|
190 | (load-system-file "defstruct") |
---|
191 | |
---|
192 | ;; The actual stream and system-stream classes |
---|
193 | ;; are created in BuiltInClass.java, however, that code does not |
---|
194 | ;; set up the structure internals correctly: we wouldn't be able |
---|
195 | ;; to :include the structure classes. Fix that here. |
---|
196 | ;; (defstruct (stream (:constructor nil) |
---|
197 | ;; (:copier nil) |
---|
198 | ;; (:predicate nil))) ;; Predicate STREAMP defined elsewhere |
---|
199 | ;; (defstruct (system-stream (:include stream) |
---|
200 | ;; (:constructor nil) |
---|
201 | ;; (:copier nil))) |
---|
202 | |
---|
203 | (load-system-file "restart") |
---|
204 | (load-system-file "late-setf") |
---|
205 | (load-system-file "debug") |
---|
206 | (load-system-file "print") |
---|
207 | (load-system-file "pprint-dispatch") |
---|
208 | (load-system-file "defsetf") |
---|
209 | (load-system-file "package") |
---|
210 | |
---|
211 | (unless (featurep :j) |
---|
212 | (unless *noinform* |
---|
213 | (%format t "Startup completed in ~A seconds.~%" |
---|
214 | (float (/ (ext:uptime) 1000))))) |
---|
215 | |
---|
216 | |
---|