0.pre7.86.flaky7.4:

	(This version dies with an AVER failure in FIND-IN-PHYSENV
		again, this time in xc of typep.lisp. Maybe, since
		I'm now substantially more knowledgeable about
		PHYSENVs than I was a few weeks ago, this will be
		easier to debug.)
	fixed bug which caused target-sxhash problem. PAIRLIS: "The
		new pairs may appear in the resulting association list
		in either forward or backward order." Egads. This is
		why the xc dies in target-sxhash: It's not a problem
		in &OPTIONAL handling, it's that I used (PAIRLIS ...)
		in a recent rewrite of LABELS as though it were
		(MAPCAR #'CONS ...), and the code breaks because
		PAIRLIS reverses the order on me. So..
	..Rewrite DEF-IR1-TRANSLATOR LABELS more thoroughly, so it
		loses its dependence on the order of PLACEHOLDER-FENV.

diff --git a/BUGS b/BUGS
index 87e1f35..c7c5c47 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1227,6 +1227,64 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   This function returns its argument. But after removing percents it
   does not work: "Result of (1- n) is not a function".
 
+131:
+  As of sbcl-0.pre7.86.flaky7.3, the cross-compiler, and probably 
+  the CL:COMPILE function (which is based on the same %COMPILE 
+  mechanism) get confused by 
+(defun sxhash (x)
+  (labels ((sxhash-number (x)
+            (etypecase x
+              (fixnum (sxhash x)) ; through DEFTRANSFORM
+              (integer (sb!bignum:sxhash-bignum x))
+              (single-float (sxhash x)) ; through DEFTRANSFORM
+              (double-float (sxhash x)) ; through DEFTRANSFORM
+              #!+long-float (long-float (error "stub: no LONG-FLOAT"))
+              (ratio (let ((result 127810327))
+                       (declare (type fixnum result))
+                       (mixf result (sxhash-number (numerator x)))
+                       (mixf result (sxhash-number (denominator x)))
+                       result))
+              (complex (let ((result 535698211))
+                         (declare (type fixnum result))
+                         (mixf result (sxhash-number (realpart x)))
+                         (mixf result (sxhash-number (imagpart x)))
+                         result))))
+          (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+))
+            (declare (type index depthoid))
+            (typecase x
+              (list
+               (if (plusp depthoid)
+                   (mix (sxhash-recurse (car x) (1- depthoid))
+                        (sxhash-recurse (cdr x) (1- depthoid)))
+                   261835505))
+              (instance
+               (if (typep x 'structure-object)
+                   (logxor 422371266
+                           (sxhash ; through DEFTRANSFORM
+                            (class-name (layout-class (%instance-layout x)))))
+                   309518995))
+              (symbol (sxhash x)) ; through DEFTRANSFORM
+              (number (sxhash-number x))
+              (array
+               (typecase x
+                 (simple-string (sxhash x)) ; through DEFTRANSFORM
+                 (string (%sxhash-substring x))
+                 (bit-vector (let ((result 410823708))
+                               (declare (type fixnum result))
+                               (dotimes (i (min depthoid (length x)))
+                                 (mixf result (aref x i)))
+                               result))
+                 (t (logxor 191020317 (sxhash (array-rank x))))))
+              (character
+               (logxor 72185131
+                       (sxhash (char-code x)))) ; through DEFTRANSFORM
+              (t 42))))
+    (sxhash-recurse x)))
+  complaining "function called with two arguments, but wants exactly
+  one" about SXHASH-RECURSE. (This might not be strictly a new bug, 
+  since IIRC post-fork CMU CL has also had problems with &OPTIONAL
+  arguments in FLET/LABELS: it might be an old Python bug which is 
+  only exercised by the new arrangement of the SBCL compiler.)
 
 KNOWN BUGS RELATED TO THE IR1 INTERPRETER
 

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 7f6f7b3..c77b257 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -117,7 +117,7 @@
 (defun sxhash (x)
   (labels ((sxhash-number (x)
             (etypecase x
-              (fixnum (sxhash x)) ; through DEFTRANSFORM
+              (fixnum (sxhash x))      ; through DEFTRANSFORM
               (integer (sb!bignum:sxhash-bignum x))
               (single-float (sxhash x)) ; through DEFTRANSFORM
               (double-float (sxhash x)) ; through DEFTRANSFORM
@@ -147,7 +147,6 @@
                             (class-name (layout-class (%instance-layout x)))))
                    309518995))
               (symbol (sxhash x)) ; through DEFTRANSFORM
-              (number (sxhash-number x))
               (array
                (typecase x
                  (simple-string (sxhash x)) ; through DEFTRANSFORM
@@ -161,6 +160,8 @@
               (character
                (logxor 72185131
                        (sxhash (char-code x)))) ; through DEFTRANSFORM
+              ;; general, inefficient case of NUMBER
+              (number (sxhash-number x))
               (t 42))))
     (sxhash-recurse x)))
 \f

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 22ce720..24a0ef5 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -601,8 +601,8 @@
   (multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
     (multiple-value-bind (names defs)
        (extract-flet-variables definitions 'labels)
-      (let* (;; dummy LABELS function vars, to be used during
-             ;; conversion of real LABELS functions
+      (let* (;; dummy LABELS functions, to be used as placeholders
+             ;; during construction of real LABELS functions
             (placeholder-funs (mapcar (lambda (name)
                                         (make-functional
                                          :%source-name name
@@ -610,24 +610,22 @@
                                                        "LABELS placeholder ~S"
                                                        name)))
                                       names))
-            (placeholder-fenv (pairlis names placeholder-funs))
              ;; the real LABELS functions, compiled in a LEXENV which
              ;; includes the dummy LABELS functions
             (real-funs
-             (let ((*lexenv* (make-lexenv :functions placeholder-fenv)))
-               (mapcar (lambda (n d)
-                         (ir1-convert-lambda d
-                                             :source-name n
+             (let ((*lexenv* (make-lexenv
+                              :functions (pairlis names placeholder-funs))))
+               (mapcar (lambda (name def)
+                         (ir1-convert-lambda def
+                                             :source-name name
                                              :debug-name (debug-namify
-                                                          "LABELS ~S" n)))
+                                                          "LABELS ~S" name)))
                        names defs))))
 
         ;; Modify all the references to the dummy function leaves so
         ;; that they point to the real function leaves.
-       (loop for real-fun in real-funs and envpair in placeholder-fenv do
-             (let ((placeholder-fun (cdr envpair)))
-               (substitute-leaf real-fun placeholder-fun)
-               (setf (cdr envpair) real-fun)))
+       (loop for real-fun in real-funs and placeholder-fun in placeholder-funs
+             do (substitute-leaf real-fun placeholder-fun))
 
         ;; Voila.
        (let ((*lexenv* (make-lexenv

diff --git a/version.lisp-expr b/version.lisp-expr
index 69065b2..935bd47 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.86.flaky7.3"
+"0.pre7.86.flaky7.4"