From: William Harold Newman Date: Mon, 12 Nov 2001 00:02:37 +0000 (+0000) Subject: 0.pre7.86.flaky7.4: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=17d48b6525fdd5f188961c863e1d1f1d44d29107;p=sbcl.git 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 --- 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 --- 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))) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 22ce720..24a0ef5 100644 --- 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 --- 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"