0.8.5.3:
authorChristophe Rhodes <csr21@cam.ac.uk>
Sat, 25 Oct 2003 21:40:48 +0000 (21:40 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Sat, 25 Oct 2003 21:40:48 +0000 (21:40 +0000)
CLISP minor issues:
... fix float-related bug: since CLISP doesn't support
denormalized single-floats, we need to construct
LEAST-POSITIVE-SHORT-FLOAT explicitly
... we need to perform a similar trick for BOOLE as we already
do for BYTE.  Rewrite the horrible package hackery to be
slightly more robust, in mitigation for the perpetuation
of this horror.

NEWS
build-order.lisp-expr
src/code/cross-boole.lisp [new file with mode: 0644]
src/code/float.lisp
src/cold/defun-load-or-cload-xcompiler.lisp
src/compiler/srctran.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index b102bcc..f5bbce8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2168,6 +2168,12 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4:
     ** intersection of CONS types now canonicalizes properly, fixing
        inconsistencies in SUBTYPEP.
 
+changes in sbcl-0.8.6 relative to sbcl-0.8.5:
+  * fixed a bootstrapping bug: the build process no longer assumes
+    that the various BOOLE-related constants have the same value in
+    host and target lisps.  (noted by Paul Dietz' test suite on an
+    SBCL binary built from CLISP)
+
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
     down, it might impact TRACE. They both encapsulate functions, and
index 22b6411..9431d78 100644 (file)
@@ -75,6 +75,7 @@
  ("src/code/cross-misc"  :not-target)
  ("src/code/cross-char"  :not-target)
  ("src/code/cross-byte"  :not-target)
+ ("src/code/cross-boole" :not-target)
  ("src/code/cross-float" :not-target)
  ("src/code/cross-io"    :not-target)
  ("src/code/cross-sap"   :not-target)
diff --git a/src/code/cross-boole.lisp b/src/code/cross-boole.lisp
new file mode 100644 (file)
index 0000000..f0d7dec
--- /dev/null
@@ -0,0 +1,52 @@
+;;;; cross-compile-time-only replacements for BOOLE machinery.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!INT")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant sb!xc:boole-clr 0)
+  (defconstant sb!xc:boole-set 1)
+  (defconstant sb!xc:boole-1   2)
+  (defconstant sb!xc:boole-2   3)
+  (defconstant sb!xc:boole-c1  4)
+  (defconstant sb!xc:boole-c2  5)
+  (defconstant sb!xc:boole-and 6)
+  (defconstant sb!xc:boole-ior 7)
+  (defconstant sb!xc:boole-xor 8)
+  (defconstant sb!xc:boole-eqv 9)
+  (defconstant sb!xc:boole-nand  10)
+  (defconstant sb!xc:boole-nor   11)
+  (defconstant sb!xc:boole-andc1 12)
+  (defconstant sb!xc:boole-andc2 13)
+  (defconstant sb!xc:boole-orc1  14)
+  (defconstant sb!xc:boole-orc2  15))
+
+(defun sb!xc:boole (boole num1 num2)
+  (cl:boole (uncross-boole boole) num1 num2))
+
+(defun uncross-boole (boole)
+  (case boole
+    (#.sb!xc:boole-clr cl:boole-clr)
+    (#.sb!xc:boole-set cl:boole-set)
+    (#.sb!xc:boole-1 cl:boole-1)
+    (#.sb!xc:boole-2 cl:boole-2)
+    (#.sb!xc:boole-c1 cl:boole-c1)
+    (#.sb!xc:boole-c2 cl:boole-c2)
+    (#.sb!xc:boole-and cl:boole-and)
+    (#.sb!xc:boole-ior cl:boole-ior)
+    (#.sb!xc:boole-xor cl:boole-xor)
+    (#.sb!xc:boole-eqv cl:boole-eqv)
+    (#.sb!xc:boole-nand cl:boole-nand)
+    (#.sb!xc:boole-nor cl:boole-nor)
+    (#.sb!xc:boole-andc1 cl:boole-andc1)
+    (#.sb!xc:boole-andc2 cl:boole-andc2)
+    (#.sb!xc:boole-orc1 cl:boole-orc1)
+    (#.sb!xc:boole-orc2 cl:boole-orc2)))
index 407b309..6f46ab2 100644 (file)
@@ -51,9 +51,9 @@
 ;;;; float parameters
 
 (defconstant least-positive-single-float (single-from-bits 0 0 1))
-(defconstant least-positive-short-float least-positive-single-float)
+(defconstant least-positive-short-float (single-from-bits 0 0 1))
 (defconstant least-negative-single-float (single-from-bits 1 0 1))
-(defconstant least-negative-short-float least-negative-single-float)
+(defconstant least-negative-short-float (single-from-bits 1 0 1))
 (defconstant least-positive-double-float (double-from-bits 0 0 1))
 #!-long-float
 (defconstant least-positive-long-float (double-from-bits 0 0 1))
index 67c9707..8d1d526 100644 (file)
 
                    ;; everything else which needs a separate
                     ;; existence in xc and target
+                   "BOOLE"
+                   "BOOLE-CLR" "BOOLE-SET" "BOOLE-1" "BOOLE-2"
+                   "BOOLE-C1" "BOOLE-C2" "BOOLE-AND" "BOOLE-IOR"
+                   "BOOLE-XOR" "BOOLE-EQV" "BOOLE-NAND" "BOOLE-NOR"
+                   "BOOLE-ANDC1" "BOOLE-ANDC2" "BOOLE-ORC1" "BOOLE-ORC2"
                    "BUILT-IN-CLASS"
                    "BYTE" "BYTE-POSITION" "BYTE-SIZE"
                    "CHAR-CODE"
                    "WITH-COMPILATION-UNIT"))
       (export (intern name package-name) package-name)))
   ;; don't watch:
-  (dolist (package-name '("SB!ALIEN"
-                         "SB!ALIEN-INTERNALS"
-                         "SB!ASSEM"
-                         "SB!BIGNUM"
-                         "SB!C"
-                         "SB!DEBUG"
-                         "SB!DI"
-                         "SB!DISASSEM"
-                         #!+sb-dyncount "SB!DYNCOUNT"
-                         "SB!FASL"
-                         "SB!IMPL"
-                         "SB!EXT"
-                         "SB!FORMAT"
-                         "SB!GRAY"
-                         "SB!INT"
-                         "SB!KERNEL"
-                         "SB!LOOP"
-                         "SB!PCL"
-                         "SB!PRETTY"
-                         "SB!PROFILE"
-                         "SB!SYS"
-                         "SB!THREAD"
-                         "SB!UNIX"
-                         "SB!VM"
-                         "SB!WALKER"))
-    (shadowing-import (mapcar (lambda (name) (find-symbol name "SB-XC"))
-                             '("BYTE" "BYTE-POSITION" "BYTE-SIZE"
-                               "DPB" "LDB" "LDB-TEST"
-                               "DEPOSIT-FIELD" "MASK-FIELD"))
-                     package-name))
+  (dolist (package (list-all-packages))
+    (when (= (mismatch (package-name package) "SB!") 3)
+      (shadowing-import
+       (mapcar (lambda (name) (find-symbol name "SB-XC"))
+              '("BYTE" "BYTE-POSITION" "BYTE-SIZE"
+                "DPB" "LDB" "LDB-TEST"
+                "DEPOSIT-FIELD" "MASK-FIELD"
+                
+                "BOOLE"
+                "BOOLE-CLR" "BOOLE-SET" "BOOLE-1" "BOOLE-2"
+                "BOOLE-C1" "BOOLE-C2" "BOOLE-AND" "BOOLE-IOR"
+                "BOOLE-XOR" "BOOLE-EQV" "BOOLE-NAND" "BOOLE-NOR"
+                "BOOLE-ANDC1" "BOOLE-ANDC2" "BOOLE-ORC1" "BOOLE-ORC2"))
+       package)))
 
   ;; Build a version of Python to run in the host Common Lisp, to be
   ;; used only in cross-compilation.
index 4da5db1..1fcfe78 100644 (file)
     (give-up-ir1-transform "BOOLE code is not a constant."))
   (let ((control (lvar-value op)))
     (case control
-      (#.boole-clr 0)
-      (#.boole-set -1)
-      (#.boole-1 'x)
-      (#.boole-2 'y)
-      (#.boole-c1 '(lognot x))
-      (#.boole-c2 '(lognot y))
-      (#.boole-and '(logand x y))
-      (#.boole-ior '(logior x y))
-      (#.boole-xor '(logxor x y))
-      (#.boole-eqv '(logeqv x y))
-      (#.boole-nand '(lognand x y))
-      (#.boole-nor '(lognor x y))
-      (#.boole-andc1 '(logandc1 x y))
-      (#.boole-andc2 '(logandc2 x y))
-      (#.boole-orc1 '(logorc1 x y))
-      (#.boole-orc2 '(logorc2 x y))
+      (#.sb!xc:boole-clr 0)
+      (#.sb!xc:boole-set -1)
+      (#.sb!xc:boole-1 'x)
+      (#.sb!xc:boole-2 'y)
+      (#.sb!xc:boole-c1 '(lognot x))
+      (#.sb!xc:boole-c2 '(lognot y))
+      (#.sb!xc:boole-and '(logand x y))
+      (#.sb!xc:boole-ior '(logior x y))
+      (#.sb!xc:boole-xor '(logxor x y))
+      (#.sb!xc:boole-eqv '(logeqv x y))
+      (#.sb!xc:boole-nand '(lognand x y))
+      (#.sb!xc:boole-nor '(lognor x y))
+      (#.sb!xc:boole-andc1 '(logandc1 x y))
+      (#.sb!xc:boole-andc2 '(logandc2 x y))
+      (#.sb!xc:boole-orc1 '(logorc1 x y))
+      (#.sb!xc:boole-orc2 '(logorc2 x y))
       (t
        (abort-ir1-transform "~S is an illegal control arg to BOOLE."
                            control)))))
index c73aa8b..69a6497 100644 (file)
@@ -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".)
-"0.8.5.2"
+"0.8.5.3"