src/code/cold-init-helper-macros.lisp

   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.
   5
   6 ;;;; This software is part of the SBCL system. See the README file for
   7 ;;;; more information.
   8 ;;;;
   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.
  14
  15 (in-package "SB!KERNEL")
  16 ;;; FIXME: Perhaps this belongs in the %SYS package like some other
  17 ;;; cold load stuff.
  18
  19 (eval-when (:compile-toplevel :load-toplevel :execute)
  20   (defvar *!cold-init-forms*))
  21
  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))
  27   #-sb-xc nil)
  28
  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).
  36   #+sb-xc (progn
  37             (setf *!cold-init-forms*
  38                   (nconc *!cold-init-forms* (copy-list forms)))
  39             nil)
  40   ;; In the cross-compilation host Lisp, cold load might not be a
  41   ;; meaningful concept and in any case would have happened long ago,
  42   ;; so just execute the forms at load time (i.e. basically as soon as
  43   ;; possible).
  44   #-sb-xc `(progn ,@forms))
  45
  46 (defmacro !defun-from-collected-cold-init-forms (name)
  47   #+sb-xc `(progn
  48              (defun ,name ()
  49                ,@*!cold-init-forms*
  50                (values))
  51              (eval-when (:compile-toplevel :execute)
  52                (makunbound '*!cold-init-forms*)))
  53   #-sb-xc (declare (ignore name)))
  54
  55 ;;; !DEFGLOBAL, !DEFPARAMETER and !DEFVAR are named by analogy
  56 ;;; with !COLD-INIT-FORMS and (not DEF!FOO) because they are
  57 ;;; basically additional cold-init-helpers to avoid the tedious sequence:
  58 ;;;    (!begin-collecting-cold-init-forms)
  59 ;;;    (defvar *foo*)
  60 ;;;    (!cold-init-forms (setq *foo* nil))
  61 ;;;    (!defun-from-cold-init-forms !some-cold-init-fun)
  62 ;;; or the less respectable (defvar *foo*) and a random SETQ in !COLD-INIT.
  63 ;;; Each is like its namesake, but also arranges so that genesis knows
  64 ;;; the initialization form, on which it calls EVAL and dumps as a constant
  65 ;;; when writing out the cold core image.
  66 (macrolet ((def (wrapper real-name)
  67              `(defmacro ,wrapper (sym value &optional (doc nil doc-p))
  68                 `(progn (eval-when (:compile-toplevel)
  69                           (!delayed-cold-set-symbol-value ',sym ',value))
  70                         (,',real-name ,sym ,value ,@(if doc-p (list doc)))))))
  71   (def !defglobal defglobal)
  72   (def !defparameter defparameter)
  73   (def !defvar defvar))
  74
  75 (defun !delayed-cold-set-symbol-value (symbol value-form)
  76   ;; Obfuscate the reference into SB-COLD to avoid "bad package for target"
  77   (let ((list (find-symbol "*SYMBOL-VALUES-FOR-GENESIS*" "SB-COLD")))
  78     (set list (acons symbol
  79                      (cons value-form (package-name *package*))
  80                      (delete symbol (symbol-value list) :key #'car)))))
  81
  82 ;;; FIXME: Consider renaming this file asap.lisp,
  83 ;;; and the renaming the various things
  84 ;;;   *ASAP-FORMS* or *REVERSED-ASAP-FORMS*
  85 ;;;   WITH-ASAP-FORMS
  86 ;;;   ASAP or EVAL-WHEN-COLD-LOAD
  87 ;;;   DEFUN-FROM-ASAP-FORMS
  88 ;;; If so, add a comment explaining that ASAP is colloquial English for "as
  89 ;;; soon as possible", and has nothing to do with "system area pointer".