1 ;;;; This software is part of the SBCL system. See the README file for
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.
10 (in-package "SB!KERNEL")
12 ;;;; the DEF!CONSTANT macro
14 ;;; FIXME: This code was created by cut-and-paste from the
15 ;;; corresponding code for DEF!TYPE. DEF!CONSTANT, DEF!TYPE and
16 ;;; DEF!MACRO 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.
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
))
29 (defconstant ,@(cdr whole
))
31 ,(unless (eql (find-symbol (symbol-name name
) :cl
) name
)
32 `(defconstant ,@(cdr whole
)))
34 ,(let ((form `(sb!xc
:defconstant
,@(cdr whole
))))
35 (if (boundp '*delayed-def
!constants
*)
36 `(push ',form
*delayed-def
!constants
*)
39 ;;; machinery to implement DEF!CONSTANT delays
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
*)
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."))))
57 (defun %defconstant-eqx-value
(symbol expr eqx
)
58 (declare (type function eqx
))
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
))
65 ;;; generalization of DEFCONSTANT to values which are the same not
66 ;;; under EQL but under e.g. EQUAL or EQUALP
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.
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
)))))
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.
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
))
99 (sb!c
:source-location
)
100 ,@(when doc
(list doc
)))))