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!IMPL")
12 ;;; We need a mechanism different from the usual SYMBOL-VALUE during cross-
13 ;;; compilation so we don't clobber the host Lisp's manifest constants.
14 ;;; This was formerly done using the globaldb, so emulate exactly the
15 ;;; calls to UNCROSS in (SETF INFO) and INFO because that works just fine.
16 ;;; Also, as noted in 'constantp.lisp'
17 ;;; "KLUDGE: superficially, this might look good enough..."
18 ;;; we should enforce that we not wrongly look at a host constant where
19 ;;; a target constant is intended. This specialized accessor, in lieu of INFO
20 ;;; facilitates implementing something like that, though in fact ir1tran is
21 ;;; already able to generate some warnings about host constant usage.
24 (defun (setf sb
!c
::xc-constant-value
) (newval sym
)
25 (setf (get (uncross sym
) :sb-xc-constant-val
) newval
))
26 (defun sb!c
::xc-constant-value
(sym) ; return 2 values as does (INFO ...)
27 (multiple-value-bind (indicator value foundp
)
28 (get-properties (symbol-plist (uncross sym
)) '(:sb-xc-constant-val
))
29 (declare (ignore indicator
))
30 (values value
(not (null foundp
))))))
32 (def!macro sb
!xc
:defconstant
(name value
&optional
(doc nil docp
))
34 "Define a global constant, saying that the value is constant and may be
35 compiled into code. If the variable already has a value, and this is not
36 EQL to the new value, the code is not portable (undefined behavior). The
37 third argument is an optional documentation string for the variable."
38 `(eval-when (:compile-toplevel
:load-toplevel
:execute
)
39 (sb!c
::%defconstant
',name
,value
(sb!c
:source-location
)
43 ;;; the guts of DEFCONSTANT
44 (defun sb!c
::%defconstant
(name value source-location
&optional
(doc nil docp
))
45 (unless (symbolp name
)
46 (error "The constant name is not a symbol: ~S" name
))
47 (when (looks-like-name-of-special-var-p name
)
48 (style-warn 'asterisks-around-constant-variable-name
49 :format-control
"defining ~S as a constant"
50 :format-arguments
(list name
)))
51 (sb!c
:with-source-location
(source-location)
52 (setf (info :source-location
:constant name
) source-location
))
53 (let ((kind (info :variable
:kind name
)))
56 ;; Note: This behavior (discouraging any non-EQL modification)
57 ;; is unpopular, but it is specified by ANSI (i.e. ANSI says a
58 ;; non-EQL change has undefined consequences). If people really
59 ;; want bindings which are constant in some sense other than
60 ;; EQL, I suggest either just using DEFVAR (which is usually
61 ;; appropriate, despite the un-mnemonic name), or defining
62 ;; something like the DEFCONSTANT-EQX macro used in SBCL (which
63 ;; is occasionally more appropriate). -- WHN 2001-12-21
65 (if (typep name
'(or boolean keyword
))
66 ;; Non-continuable error.
67 (about-to-modify-symbol-value name
'defconstant
)
68 (let ((old (symbol-value name
)))
69 (unless (eql value old
)
70 (multiple-value-bind (ignore aborted
)
71 (with-simple-restart (abort "Keep the old value.")
72 (cerror "Go ahead and change the value."
77 (declare (ignore ignore
))
79 (return-from sb
!c
::%defconstant name
))))))
80 (warn "redefining a MAKUNBOUND constant: ~S" name
)))
82 ;; (This is OK -- undefined variables are of this kind. So we
83 ;; don't warn or error or anything, just fall through.)
85 (t (warn "redefining ~(~A~) ~S to be a constant" kind name
))))
86 ;; We ought to be consistent in treating any change of :VARIABLE :KIND
87 ;; as a continuable error. The above CASE expression pre-dates the
88 ;; existence of symbol-macros (I believe), but at a bare minimum,
89 ;; INFO should return NIL for its second value if requesting the
90 ;; :macro-expansion of something that is getting defined as constant.
91 (clear-info :variable
:macro-expansion name
)
92 (clear-info :source-location
:symbol-macro name
)
94 (setf (fdocumentation name
'variable
) doc
))
96 (%set-symbol-value name value
)
99 ;; Redefining our cross-compilation host's CL symbols would be poor form.
101 ;; FIXME: Having to check this and then not treat it as a fatal error
102 ;; seems like a symptom of things being pretty broken. It's also a problem
103 ;; in and of itself, since it makes it too easy for cases of using the
104 ;; cross-compilation host Lisp's CL constant values in the target Lisp to
105 ;; slip by. I got backed into this because the cross-compiler translates
106 ;; DEFCONSTANT SB!XC:FOO into DEFCONSTANT CL:FOO. It would be good to
107 ;; unscrew the cross-compilation package hacks so that that translation
108 ;; doesn't happen. Perhaps: * Replace SB-XC with SB-CL. SB-CL exports all
109 ;; the symbols which ANSI requires to be exported from CL. * Make a
110 ;; nickname SB!CL which behaves like SB!XC. * Go through the
111 ;; loaded-on-the-host code making every target definition be in SB-CL.
112 ;; E.g. DEFMACRO-MUNDANELY DEFCONSTANT becomes DEFMACRO-MUNDANELY
113 ;; SB!CL:DEFCONSTANT. * Make IN-TARGET-COMPILATION-MODE do UNUSE-PACKAGE
114 ;; CL and USE-PACKAGE SB-CL in each of the target packages (then undo it
115 ;; on exit). * Make the cross-compiler's implementation of EVAL-WHEN
116 ;; (:COMPILE-TOPLEVEL) do UNCROSS. (This may not require any change.) *
117 ;; Hack GENESIS as necessary so that it outputs SB-CL stuff as COMMON-LISP
118 ;; stuff. * Now the code here can assert that the symbol being defined
119 ;; isn't in the cross-compilation host's CL package.
120 (unless (eql (find-symbol (symbol-name name
) :cl
) name
)
121 ;; KLUDGE: In the cross-compiler, we use the cross-compilation host's
122 ;; DEFCONSTANT macro instead of just (SETF SYMBOL-VALUE), in order to
123 ;; get whatever blessing the cross-compilation host may expect for a
124 ;; global (SETF SYMBOL-VALUE). (CMU CL, at least around 2.4.19,
125 ;; generated full WARNINGs for code -- e.g. DEFTYPE expanders -- which
126 ;; referred to symbols which had been set by (SETF SYMBOL-VALUE). I
127 ;; doubt such warnings are ANSI-compliant, but I'm not sure, so I've
128 ;; written this in a way that CMU CL will tolerate and which ought to
129 ;; work elsewhere too.) -- WHN 2001-03-24
130 (eval `(defconstant ,name
',value
)))
131 ;; It would certainly be awesome if this was only needed for symbols
132 ;; in CL. Unfortunately, that is not the case. Maybe some are moved
133 ;; back in CL later on?
134 (setf (sb!c
::xc-constant-value name
) value
))
135 (setf (info :variable
:kind name
) :constant
)