src/code/defbangconstant.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!KERNEL")
  11 \f
  12 ;;;; the DEF!CONSTANT macro
  13
  14 ;;; FIXME: This code was created by cut-and-paste from the
  15 ;;; corresponding code for DEF!TYPE. DEF!CONSTANT and DEF!TYPE
  16 ;;; are currently very parallel, and if we ever manage to
  17 ;;; rationalize the use of UNCROSS in the cross-compiler, they should
  18 ;;; become completely parallel, at which time they should be merged to
  19 ;;; eliminate the duplicate code.
  20
  21 ;;; *sigh* -- Even the comments are cut'n'pasted :-/ If I were more
  22 ;;; confident in my understanding, I might try to do drastic surgery,
  23 ;;; but my head is currently spinning (host? target? both?) so I'll go
  24 ;;; for the minimal changeset... -- CSR, 2002-05-11
  25 (defmacro def!constant (&whole whole name value &optional doc)
  26   (declare (ignore value doc #-sb-xc-host name))
  27   `(progn
  28      #-sb-xc-host
  29      (defconstant ,@(cdr whole))
  30      #+sb-xc-host
  31      ,(unless (eql (find-symbol (symbol-name name) :cl) name)
  32         `(defconstant ,@(cdr whole)))
  33      #+sb-xc-host
  34      ,(let ((form `(sb!xc:defconstant ,@(cdr whole))))
  35         (if (boundp '*delayed-def!constants*)
  36             `(push ',form *delayed-def!constants*)
  37             form))))
  38
  39 ;;; machinery to implement DEF!CONSTANT delays
  40 #+sb-xc-host
  41 (progn
  42   (/show "binding *DELAYED-DEF!CONSTANTS*")
  43   (defvar *delayed-def!constants* nil)
  44   (/show "done binding *DELAYED-DEF!CONSTANTS*")
  45   (defun force-delayed-def!constants ()
  46     (if (boundp '*delayed-def!constants*)
  47         (progn
  48           (mapc #'eval *delayed-def!constants*)
  49           (makunbound '*delayed-def!constants*))
  50         ;; This condition is probably harmless if it comes up when
  51         ;; interactively experimenting with the system by loading a
  52         ;; source file into it more than once. But it's worth warning
  53         ;; about it because it definitely shouldn't come up in an
  54         ;; ordinary build process.
  55         (warn "*DELAYED-DEF!CONSTANTS* is already unbound."))))
  56
  57 (defun %defconstant-eqx-value (symbol expr eqx)
  58   (declare (type function eqx))
  59   (if (boundp symbol)
  60       (let ((oldval (symbol-value symbol)))
  61         ;; %DEFCONSTANT will give a choice of how to proceeed on error.
  62         (if (funcall eqx oldval expr) oldval expr))
  63       expr))
  64
  65 ;;; generalization of DEFCONSTANT to values which are the same not
  66 ;;; under EQL but under e.g. EQUAL or EQUALP
  67 ;;;
  68 ;;; DEFCONSTANT-EQX is to be used instead of DEFCONSTANT for values
  69 ;;; which are appropriately compared using the function given by the
  70 ;;; EQX argument instead of EQL.
  71 ;;;
  72 (let () ; ensure non-toplevelness
  73   ;; :compile-toplevel for #+sb-xc-host is (mostly) irrelevant,
  74   ;; since the fasl file will be loaded.
  75   ;; the #-sb-xc-host code is different though.
  76   (#+sb-xc-host defmacro
  77    #-sb-xc-host sb!xc:defmacro
  78     defconstant-eqx (symbol expr eqx &optional doc)
  79       `(def!constant ,symbol
  80          (%defconstant-eqx-value ',symbol ,expr ,eqx)
  81          ,@(when doc (list doc)))))
  82
  83 ;; We want DEFCONSTANT-EQX to work in cold-load so that non-EQL-comparable
  84 ;; constants (like BYTE specifiers) can be accessed immediately in cold-init.
  85 ;; There are two issues: (1) we can't have expressions like (BYTE s p)
  86 ;; reach the fopcompiler, because it would emit a fop-funcall. That would
  87 ;; entail conversion of arguments from target to host integers, then
  88 ;; eval'ing and pushing a target object. It's easier to fold BYTE now and
  89 ;; have it dumped in the usual way. SB!XC:CONSTANTP recognizes that BYTE
  90 ;; can be folded; and (2) we must avoid %DEFCONSTANT-EQX-VALUE.
  91 #+sb-xc
  92 (eval-when (:compile-toplevel) ; SB!XC:DEFMACRO took care of load-time
  93   (sb!xc:defmacro defconstant-eqx (symbol expr eqx &optional doc)
  94     (declare (ignore eqx))
  95     `(sb!c::%defconstant ',symbol
  96                          ,(if (sb!xc:constantp expr)
  97                               (list 'quote (constant-form-value expr))
  98                               expr)
  99                          (sb!c:source-location)
 100                          ,@(when doc (list doc)))))