From: pkhuong <pkhuong>
Date: Sun, 15 Jun 2008 11:13:41 +0000 (+0000)
Subject: 1.0.17.35: Bug fixes: cross-compiler's lookup of constants, recursive escaping
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=68664fcaa607ab61bc53bce1e9795622942135a4;p=sbcl.git

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.
---

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index d9d0d0e..e28cb0e 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -131,7 +131,7 @@
   (let ((block-name (when env
                       (car (find-if #'car (sb!c::lexenv-blocks env))))))
     (if block-name
-        (gensym (format nil "~A[~S]" name block-name))
+        (gensym (format nil "~A[~A]" name block-name))
         (gensym name))))
 
 
diff --git a/src/compiler/defconstant.lisp b/src/compiler/defconstant.lisp
index 5f155eb..0b6f423 100644
--- a/src/compiler/defconstant.lisp
+++ b/src/compiler/defconstant.lisp
@@ -99,6 +99,10 @@ the usual naming convention (names like *FOO*) for special variables"
       ;; 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)
diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index 8436730..1fbdb7c 100644
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -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
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 91b7a69..3e38ef7 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -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
diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index afcb90d..fb27f29 100644
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -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
diff --git a/version.lisp-expr b/version.lisp-expr
index 1d46a77..39393ca 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.17.34"
+"1.0.17.35"