[Sbcl-commits] CVS: sbcl/src/compiler defconstant.lisp, 1.5, 1.6 globaldb.lisp, 1.54, 1.55 ir1tran.lisp, 1.162, 1.163 node.lisp, 1.74, 1.75

[Paul K. <pk...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv29488/sbcl/src/compiler

Modified Files:
	defconstant.lisp globaldb.lisp ir1tran.lisp node.lisp 
Log Message:
1.0.17.35: Bug fixes: cross-compiler's lookup of constants, recursive escaping

 * Reinstate :CONSTANT-VALUE in the infodb as :XC-CONSTANT-VALUE
   during cross-compilation, since we can't override our host's
   standard constants.

 * Avoid recursive escaping in BLOCK-GENSYM.


Index: defconstant.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/defconstant.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- defconstant.lisp	4 Jun 2008 12:39:40 -0000	1.5
+++ defconstant.lisp	15 Jun 2008 11:13:41 -0000	1.6
@@ -99,6 +99,10 @@
       ;; 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))))
+      (eval `(defconstant ,name ',value)))
+    ;; It would certainly be awesome if this was only needed for symbols
+    ;; in CL. Unfortunately, that is not the case. Maybe some are moved
+    ;; back in CL later on?
+    (setf (info :variable :xc-constant-value name) value))
   (setf (info :variable :kind name) :constant)
   name)

Index: globaldb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/globaldb.lisp,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -d -r1.54 -r1.55
--- globaldb.lisp	4 Jun 2008 12:39:40 -0000	1.54
+++ globaldb.lisp	15 Jun 2008 11:13:41 -0000	1.55
@@ -1084,6 +1084,15 @@
   :type-spec (member :declared :assumed :defined)
   :default :assumed)
 
+;;; We only need a mechanism different from the
+;;; usual SYMBOL-VALUE for the cross compiler.
+#+sb-xc-host
+(define-info-type
+  :class :variable
+  :type :xc-constant-value
+  :type-spec t
+  :default nil)
+
 ;;; the macro-expansion for symbol-macros
 (define-info-type
   :class :variable

Index: ir1tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran.lisp,v
retrieving revision 1.162
retrieving revision 1.163
diff -u -d -r1.162 -r1.163
--- ir1tran.lisp	6 Jun 2008 12:00:24 -0000	1.162
+++ ir1tran.lisp	15 Jun 2008 11:13:42 -0000	1.163
@@ -241,7 +241,20 @@
                        (type (type-specifier (info :variable :type name))))
                    `(macro . (the ,type ,expansion))))
                 (:constant
-                 (find-constant (symbol-value name) name))
+                 (let ((value (symbol-value name)))
+                   ;; Override the values of standard symbols in XC,
+                   ;; since we can't redefine them.
+                   #+sb-xc-host
+                   (when (eql (find-symbol (symbol-name name) :cl) name)
+                     (multiple-value-bind (xc-value foundp)
+                         (info :variable :xc-constant-value name)
+                       (cond (foundp
+                              (setf value xc-value))
+                             ((not (eq value name))
+                              (compiler-warn
+                               "Using cross-compilation host's definition of ~S: ~A~%"
+                               name (symbol-value name))))))
+                   (find-constant value name)))
                 (t
                  (make-global-var :kind kind
                                   :%source-name name

Index: node.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/node.lisp,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -d -r1.74 -r1.75
--- node.lisp	4 Jun 2008 12:39:41 -0000	1.74
+++ node.lisp	15 Jun 2008 11:13:42 -0000	1.75
@@ -670,7 +670,7 @@
 (def!struct (constant (:constructor make-constant (value
                                                    &aux
                                                    (type (ctype-of value))
-                                                   (%source-name '.anonynous.)
+                                                   (%source-name '.anonymous.)
                                                    (where-from :defined)))
                       (:include leaf))
   ;; the value of the constant