From df1d29462e178526ae1f13103dc638ecbf20ceec Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Mon, 10 Oct 2016 22:51:47 -0400 Subject: [PATCH] No more song and dance routine with BOOLE- constants. - Remove redundant duplicate list of the constant names from defun-load-or-cload-xcompiler. Keep the exports. - Don't shadowing-import them into all SB! packages. - Don't define a version of BOOLE that takes SB-XC constants while punting to the host implementation. --- build-order.lisp-expr | 1 - src/code/cross-boole.lisp | 52 ---------------------- src/code/early-cl.lisp | 69 +++++++++++++++++++++++++++++ src/code/numbers.lisp | 69 ----------------------------- src/cold/defun-load-or-cload-xcompiler.lisp | 12 +---- 5 files changed, 70 insertions(+), 133 deletions(-) delete mode 100644 src/code/cross-boole.lisp diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 8fdc71f3a..c22d7274c 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -84,7 +84,6 @@ ("src/code/cross-byte" :not-target) ("src/code/cross-misc" :not-target) ("src/code/cross-char" :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 deleted file mode 100644 index f0d7dec5d..000000000 --- a/src/code/cross-boole.lisp +++ /dev/null @@ -1,52 +0,0 @@ -;;;; 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/early-cl.lisp b/src/code/early-cl.lisp index 55a9fe9c0..59d8a51e6 100644 --- a/src/code/early-cl.lisp +++ b/src/code/early-cl.lisp @@ -24,3 +24,72 @@ single-float standard-char stream string base-char symbol t vector)) (defvar sb!sys::*software-version* nil) + +;;; The BOOLE function dispaches to any logic operation depending on +;;; the value of an argument. Presently, legal selector values are [0..15]. +;;; BOOLE is open coded for calls with any of the constants declared below. + +(defconstant sb!xc:boole-clr 0 + #!+sb-doc + "Boole function op, makes BOOLE return 0.") + +(defconstant sb!xc:boole-set 1 + #!+sb-doc + "Boole function op, makes BOOLE return -1.") + +(defconstant sb!xc:boole-1 2 + #!+sb-doc + "Boole function op, makes BOOLE return integer1.") + +(defconstant sb!xc:boole-2 3 + #!+sb-doc + "Boole function op, makes BOOLE return integer2.") + +(defconstant sb!xc:boole-c1 4 + #!+sb-doc + "Boole function op, makes BOOLE return complement of integer1.") + +(defconstant sb!xc:boole-c2 5 + #!+sb-doc + "Boole function op, makes BOOLE return complement of integer2.") + +(defconstant sb!xc:boole-and 6 + #!+sb-doc + "Boole function op, makes BOOLE return logand of integer1 and integer2.") + +(defconstant sb!xc:boole-ior 7 + #!+sb-doc + "Boole function op, makes BOOLE return logior of integer1 and integer2.") + +(defconstant sb!xc:boole-xor 8 + #!+sb-doc + "Boole function op, makes BOOLE return logxor of integer1 and integer2.") + +(defconstant sb!xc:boole-eqv 9 + #!+sb-doc + "Boole function op, makes BOOLE return logeqv of integer1 and integer2.") + +(defconstant sb!xc:boole-nand 10 + #!+sb-doc + "Boole function op, makes BOOLE return log nand of integer1 and integer2.") + +(defconstant sb!xc:boole-nor 11 + #!+sb-doc + "Boole function op, makes BOOLE return lognor of integer1 and integer2.") + +(defconstant sb!xc:boole-andc1 12 + #!+sb-doc + "Boole function op, makes BOOLE return logandc1 of integer1 and integer2.") + +(defconstant sb!xc:boole-andc2 13 + #!+sb-doc + "Boole function op, makes BOOLE return logandc2 of integer1 and integer2.") + +(defconstant sb!xc:boole-orc1 14 + #!+sb-doc + "Boole function op, makes BOOLE return logorc1 of integer1 and integer2.") + +(defconstant sb!xc:boole-orc2 15 + #!+sb-doc + "Boole function op, makes BOOLE return logorc2 of integer1 and integer2.") + diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index d0a640fce..54765f718 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -1230,75 +1230,6 @@ and the number of 0 bits if INTEGER is negative." ;;;; BOOLE -;;; The boole function dispaches to any logic operation depending on -;;; the value of a variable. Presently, legal selector values are [0..15]. -;;; boole is open coded for calls with a constant selector. or with calls -;;; using any of the constants declared below. - -(defconstant boole-clr 0 - #!+sb-doc - "Boole function op, makes BOOLE return 0.") - -(defconstant boole-set 1 - #!+sb-doc - "Boole function op, makes BOOLE return -1.") - -(defconstant boole-1 2 - #!+sb-doc - "Boole function op, makes BOOLE return integer1.") - -(defconstant boole-2 3 - #!+sb-doc - "Boole function op, makes BOOLE return integer2.") - -(defconstant boole-c1 4 - #!+sb-doc - "Boole function op, makes BOOLE return complement of integer1.") - -(defconstant boole-c2 5 - #!+sb-doc - "Boole function op, makes BOOLE return complement of integer2.") - -(defconstant boole-and 6 - #!+sb-doc - "Boole function op, makes BOOLE return logand of integer1 and integer2.") - -(defconstant boole-ior 7 - #!+sb-doc - "Boole function op, makes BOOLE return logior of integer1 and integer2.") - -(defconstant boole-xor 8 - #!+sb-doc - "Boole function op, makes BOOLE return logxor of integer1 and integer2.") - -(defconstant boole-eqv 9 - #!+sb-doc - "Boole function op, makes BOOLE return logeqv of integer1 and integer2.") - -(defconstant boole-nand 10 - #!+sb-doc - "Boole function op, makes BOOLE return log nand of integer1 and integer2.") - -(defconstant boole-nor 11 - #!+sb-doc - "Boole function op, makes BOOLE return lognor of integer1 and integer2.") - -(defconstant boole-andc1 12 - #!+sb-doc - "Boole function op, makes BOOLE return logandc1 of integer1 and integer2.") - -(defconstant boole-andc2 13 - #!+sb-doc - "Boole function op, makes BOOLE return logandc2 of integer1 and integer2.") - -(defconstant boole-orc1 14 - #!+sb-doc - "Boole function op, makes BOOLE return logorc1 of integer1 and integer2.") - -(defconstant boole-orc2 15 - #!+sb-doc - "Boole function op, makes BOOLE return logorc2 of integer1 and integer2.") - (defun boole (op integer1 integer2) #!+sb-doc "Bit-wise boolean function on two integers. Function chosen by OP: diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp index bd3f377dc..f220940a2 100644 --- a/src/cold/defun-load-or-cload-xcompiler.lisp +++ b/src/cold/defun-load-or-cload-xcompiler.lisp @@ -168,10 +168,6 @@ ;; 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" @@ -218,13 +214,7 @@ (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")) + "DEPOSIT-FIELD" "MASK-FIELD")) package))) ;; Build a version of Python to run in the host Common Lisp, to be -- 2.11.4.GIT