0.6.11.26:

[sbcl.git] / src / code / macros.lisp

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index d4731bb..c55f1b9 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -103,7 +103,7 @@
 ;;; the guts of DEFCONSTANT
 (defun sb!c::%defconstant (name value doc)
   (unless (symbolp name)
-    (error "constant name not a symbol: ~S" name))
+    (error "The constant name is not a symbol: ~S" name))
   (about-to-modify name)
   (let ((kind (info :variable :kind name)))
     (case kind
@@ -128,7 +128,64 @@
       (t (warn "redefining ~(~A~) ~S to be a constant" kind name))))
   (when doc
     (setf (fdocumentation name 'variable) doc))
-  (setf (symbol-value name) value)
+
+  ;; We want to set the cross-compilation host's symbol value, not just
+  ;; the cross-compiler's (INFO :VARIABLE :CONSTANT-VALUE NAME), so
+  ;; that code like
+  ;;   (defconstant max-entries 61)
+  ;;   (deftype entry-index () `(mod ,max-entries))
+  ;; will be cross-compiled correctly.
+  #-sb-xc-host (setf (symbol-value name) value)
+  #+sb-xc-host (progn
+                (/show (symbol-package name))
+                ;; Redefining our cross-compilation host's CL symbols
+                ;; would be poor form.
+                ;;
+                ;; FIXME: Having to check this and then not treat it
+                ;; as a fatal error seems like a symptom of things
+                ;; being pretty broken. It's also a problem in and of
+                ;; itself, since it makes it too easy for cases of
+                ;; using the cross-compilation host Lisp's CL
+                ;; constant values in the target Lisp to slip by. I
+                ;; got backed into this because the cross-compiler
+                ;; translates DEFCONSTANT SB!XC:FOO into DEFCONSTANT
+                ;; CL:FOO. It would be good to unscrew the
+                ;; cross-compilation package hacks so that that
+                ;; translation doesn't happen. Perhaps:
+                ;;   * Replace SB-XC with SB-CL. SB-CL exports all the 
+                ;;     symbols which ANSI requires to be exported from CL.
+                ;;   * Make a nickname SB!CL which behaves like SB!XC.
+                ;;   * Go through the loaded-on-the-host code making
+                ;;     every target definition be in SB-CL. E.g.
+                ;;     DEFMACRO-MUNDANELY DEFCONSTANT becomes
+                ;;     DEFMACRO-MUNDANELY SB!CL:DEFCONSTANT.
+                ;;   * Make IN-TARGET-COMPILATION-MODE do 
+                ;;     UNUSE-PACKAGE CL and USE-PACKAGE SB-CL in each
+                ;;     of the target packages (then undo it on exit).
+                ;;   * Make the cross-compiler's implementation of
+                ;;     EVAL-WHEN (:COMPILE-TOPLEVEL) do UNCROSS.
+                ;;     (This may not require any change.)
+                ;;   * Hack GENESIS as necessary so that it outputs
+                ;;     SB-CL stuff as COMMON-LISP stuff.
+                ;;   * Now the code here can assert that the symbol
+                ;;     being defined isn't in the cross-compilation
+                ;;     host's CL package.
+                (unless (eql (find-symbol (symbol-name name) :cl) name)
+                  ;; KLUDGE: In the cross-compiler, we use the
+                  ;; cross-compilation host's DEFCONSTANT macro
+                  ;; instead of just (SETF SYMBOL-VALUE), in order to
+                  ;; get whatever blessing the cross-compilation host
+                  ;; may expect for a global (SETF SYMBOL-VALUE).
+                  ;; (CMU CL, at least around 2.4.19, generated full
+                  ;; WARNINGs for code -- e.g. DEFTYPE expanders --
+                  ;; which referred to symbols which had been set by
+                  ;; (SETF SYMBOL-VALUE). I doubt such warnings are
+                  ;; ANSI-compliant, but I'm not sure, so I've
+                  ;; written this in a way that CMU CL will tolerate
+                  ;; and which ought to work elsewhere too.) -- WHN
+                  ;; 2001-03-24
+                  (eval `(defconstant ,name ',value))))
+
   (setf (info :variable :kind name) :constant)
   (setf (info :variable :constant-value name) value)
   name)