1 ;;;; This file contains machinery for collecting forms that, in the
2 ;;;; target Lisp, must happen before top level forms are run. The
3 ;;;; forms are stuffed into named functions which will be explicitly
4 ;;;; called in the appropriate order by !COLD-INIT.
6 ;;;; This software is part of the SBCL system. See the README file for
9 ;;;; This software is derived from the CMU CL system, which was
10 ;;;; written at Carnegie Mellon University and released into the
11 ;;;; public domain. The software is in the public domain and is
12 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
13 ;;;; files for more information.
15 (in-package "SB!KERNEL")
16 ;;; FIXME: Perhaps this belongs in the %SYS package like some other
19 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
20 (defvar *!cold-init-forms
*))
22 (defmacro !begin-collecting-cold-init-forms
()
23 #+sb-xc
'(eval-when (:compile-toplevel
:execute
)
24 (when (boundp '*!cold-init-forms
*)
25 (warn "discarding old *!COLD-INIT-FORMS* value"))
26 (setf *!cold-init-forms
* nil
))
29 ;;; Note: Unlike the analogous COLD-INIT macro in CMU CL, this macro
30 ;;; makes no attempt to simulate a top level situation by treating
31 ;;; EVAL-WHEN forms specially.
32 (defmacro !cold-init-forms
(&rest forms
)
33 ;; In the target Lisp, stuff the forms into a named function which
34 ;; will presumably be executed at the appropriate stage of cold load
35 ;; (i.e. basically as soon as possible).
37 (setf *!cold-init-forms
*
38 (nconc *!cold-init-forms
* (copy-list forms
)))
40 ;; In the cross-compilation host Lisp, cold load is not a
41 ;; meaningful concept. Just execute the forms at load time.
42 #-sb-xc
`(progn ,@forms
))
44 (defmacro !defun-from-collected-cold-init-forms
(name)
49 (eval-when (:compile-toplevel
:execute
)
50 (makunbound '*!cold-init-forms
*)))
51 #-sb-xc
(declare (ignore name
)))
53 ;;; !DEFGLOBAL, !DEFPARAMETER and !DEFVAR are named by analogy
54 ;;; with !COLD-INIT-FORMS and (not DEF!FOO) because they are
55 ;;; basically additional cold-init-helpers to avoid the tedious sequence:
56 ;;; (!begin-collecting-cold-init-forms)
58 ;;; (!cold-init-forms (setq *foo* nil))
59 ;;; (!defun-from-cold-init-forms !some-cold-init-fun)
60 ;;; or the less respectable (defvar *foo*) and a random SETQ in !COLD-INIT.
61 ;;; Each is like its namesake, but also arranges so that genesis knows
62 ;;; the initialization form, on which it calls EVAL and dumps as a constant
63 ;;; when writing out the cold core image.
64 (macrolet ((def (wrapper real-name
)
65 `(defmacro ,wrapper
(sym value
&optional
(doc nil doc-p
))
66 `(progn (,',real-name
,sym
,value
,@(if doc-p
(list doc
)))
67 #-sb-xc-host
(sb!fasl
::setq-no-questions-asked
,sym
,value
)))))
68 (def !defglobal defglobal
)
69 (def !defparameter defparameter
)
72 (defmacro !set-load-form-method
(class-name usable-by
&optional method
)
74 ;; :host - the host compiler can execute this M-L-F method
75 ;; :xc - the cross-compiler can execute this M-L-F method
76 ;; :target - the target compiler can execute this M-L-F method
77 (assert (and usable-by
78 (every (lambda (x) (member x
'(:host
:xc
:target
)))
80 (multiple-value-bind (host-expr target-expr
)
83 (values '(cl:make-load-form-saving-slots obj
:environment env
)
84 '(sb!xc
:make-load-form-saving-slots obj
:environment env
)))
86 (values '(bug "Can't :ignore-it for host") :ignore-it
))
88 (assert (not (member :host usable-by
)))
89 (values nil
`(funcall ,method obj env
))))
91 ,@(when (or #+sb-xc-host
(member :host usable-by
))
92 `((defmethod make-load-form ((obj ,class-name
) &optional env
)
94 ,@(when (or #+sb-xc-host
(member :xc usable-by
))
95 ;; Use the host's CLOS implementation to select the target's method.
96 `((defmethod sb!xc
:make-load-form
((obj ,class-name
) &optional env
)
97 (declare (ignorable obj env
))
99 ,@(when (or #-sb-xc-host
(member :target usable-by
))
100 ;; Use the target's CLOS implementation
101 `((defmethod make-load-form ((obj ,class-name
) &optional env
)
102 (declare (ignorable obj env
))
105 ;;; FIXME: Consider renaming this file asap.lisp,
106 ;;; and the renaming the various things
107 ;;; *ASAP-FORMS* or *REVERSED-ASAP-FORMS*
109 ;;; ASAP or EVAL-WHEN-COLD-LOAD
110 ;;; DEFUN-FROM-ASAP-FORMS
111 ;;; If so, add a comment explaining that ASAP is colloquial English for "as
112 ;;; soon as possible", and has nothing to do with "system area pointer".