From f8893c7c658bf9d9e0757c63e47af2fdea810f04 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 25 Oct 2003 21:40:48 +0000 Subject: [PATCH] 0.8.5.3: 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 | 6 ++++ build-order.lisp-expr | 1 + src/code/cross-boole.lisp | 52 +++++++++++++++++++++++++++ src/code/float.lisp | 4 +-- src/cold/defun-load-or-cload-xcompiler.lisp | 49 ++++++++++--------------- src/compiler/srctran.lisp | 32 ++++++++--------- version.lisp-expr | 2 +- 7 files changed, 97 insertions(+), 49 deletions(-) create mode 100644 src/code/cross-boole.lisp diff --git a/NEWS b/NEWS index b102bcc..f5bbce8 100644 --- 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 diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 22b6411..9431d78 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -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 index 0000000..f0d7dec --- /dev/null +++ b/src/code/cross-boole.lisp @@ -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))) diff --git a/src/code/float.lisp b/src/code/float.lisp index 407b309..6f46ab2 100644 --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -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)) diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp index 67c9707..8d1d526 100644 --- a/src/cold/defun-load-or-cload-xcompiler.lisp +++ b/src/cold/defun-load-or-cload-xcompiler.lisp @@ -90,6 +90,11 @@ ;; 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" @@ -129,36 +134,20 @@ "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. diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 4da5db1..1fcfe78 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2612,22 +2612,22 @@ (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))))) diff --git a/version.lisp-expr b/version.lisp-expr index c73aa8b..69a6497 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".) -"0.8.5.2" +"0.8.5.3" -- 1.7.10.4