0.7.4.30:
authorChristophe Rhodes <csr21@cam.ac.uk>
Thu, 13 Jun 2002 08:54:37 +0000 (08:54 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Thu, 13 Jun 2002 08:54:37 +0000 (08:54 +0000)
Merge BYTE fix.
... include LDB-TEST in the shadowed symbols
... leave hideous violation of OAOO in load-or-cload-xcompiler
unfixed for now
Minor IGNORE/IGNORABLE and IN-PACKAGE tweaks

build-order.lisp-expr
src/code/cross-byte.lisp [new file with mode: 0644]
src/code/cross-make-load-form.lisp
src/code/cross-misc.lisp
src/cold/defun-load-or-cload-xcompiler.lisp
src/compiler/srctran.lisp
version.lisp-expr

index 1e5b578..86e1c98 100644 (file)
@@ -65,6 +65,7 @@
  ;;; supplied by basic machinery
 
  ("src/code/cross-misc"  :not-target)
+ ("src/code/cross-byte"  :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-byte.lisp b/src/code/cross-byte.lisp
new file mode 100644 (file)
index 0000000..b9b8178
--- /dev/null
@@ -0,0 +1,70 @@
+;;;; cross-compile-time-only replacements for byte-specifier
+;;;; 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")
+
+(defun sb!xc:byte (size position)
+  (cons size position))
+
+(defun sb!xc:byte-size (cross-byte)
+  (car cross-byte))
+
+(defun sb!xc:byte-position (cross-byte)
+  (cdr cross-byte))
+
+(defun uncross-byte (cross-byte)
+  (cl:byte (sb!xc:byte-size cross-byte) (sb!xc:byte-position cross-byte)))
+
+(defun sb!xc:ldb (cross-byte int)
+  (cl:ldb (uncross-byte cross-byte) int))
+
+(defun sb!xc:ldb-test (cross-byte int)
+  (cl:ldb-test (uncross-byte cross-byte) int))
+
+(defun sb!xc:dpb (new cross-byte int)
+  (cl:dpb new (uncross-byte cross-byte) int))
+
+(defun sb!xc:mask-field (cross-byte int)
+  (cl:mask-field (uncross-byte cross-byte) int))
+
+(defun sb!xc:deposit-field (new cross-byte int)
+  (cl:deposit-field new (uncross-byte cross-byte) int))
+
+(define-setf-expander sb!xc:ldb (cross-byte int &environment env)
+  (multiple-value-bind (temps vals stores store-form access-form)
+      (get-setf-expansion int env)
+    (when (cdr stores)
+      (bug "SETF SB!XC:LDB too hairy!"))
+    (let ((btemp (gensym))
+         (store (gensym)))
+      (values (cons btemp temps)
+             (cons cross-byte vals)
+             (list store)
+             `(let ((,(car stores) (cl:dpb ,store (uncross-byte ,btemp) ,access-form)))
+               ,store-form
+               ,store)
+             `(cl:ldb (uncross-byte ,btemp) ,access-form)))))
+
+(define-setf-expander sb!xc:mask-field (cross-byte int &environment env)
+    (multiple-value-bind (temps vals stores store-form access-form)
+      (get-setf-expansion int env)
+    (when (cdr stores)
+      (bug "SETF SB!XC:MASK-FIELD too hairy!"))
+    (let ((btemp (gensym))
+         (store (gensym)))
+      (values (cons btemp temps)
+             (cons cross-byte vals)
+             (list store)
+             `(let ((,(car stores) (cl:deposit-field ,store (uncross-byte ,btemp) ,access-form)))
+               ,store-form
+               ,store)
+             `(cl:mask-field (uncross-byte ,btemp) ,access-form)))))
index 7e26e75..22bde12 100644 (file)
@@ -31,6 +31,9 @@
 ;;;
 ;;; Also, something along these lines can remove the special case in
 ;;; EMIT-MAKE-LOAD-FORM in src/compiler/main.lisp.
+
+(in-package "SB!INT")
+
 (defun sb!xc:make-load-form-saving-slots (object &rest args
                                          &key slot-names environment)
   (declare (ignore environment))
index 7a4152e..df93d81 100644 (file)
@@ -97,7 +97,7 @@
   (let ((result 0))
     (declare (type fixnum result))
     (do-external-symbols (i package)
-      (declare (ignore i))
+      (declare (ignorable i))
       (incf result))
     result))
 
index 8fcc696..cadc1b9 100644 (file)
@@ -89,6 +89,7 @@
                    ;; everything else which needs a separate
                     ;; existence in xc and target
                    "BUILT-IN-CLASS"
+                   "BYTE" "BYTE-POSITION" "BYTE-SIZE"
                    "CLASS" "CLASS-NAME" "CLASS-OF"
                    "COMPILE-FILE"
                    "COMPILE-FILE-PATHNAME"
                    "DEFINE-MODIFY-MACRO"
                    "DEFINE-SETF-EXPANDER"
                    "DEFMACRO" "DEFSETF" "DEFSTRUCT" "DEFTYPE"
+                   "DEPOSIT-FIELD" "DPB"
                    "FBOUNDP" "FDEFINITION" "FMAKUNBOUND"
                    "FIND-CLASS"
                    "GET-SETF-EXPANSION"
+                   "LDB" "LDB-TEST"
                    "LISP-IMPLEMENTATION-TYPE" "LISP-IMPLEMENTATION-VERSION"
                    "MACRO-FUNCTION"
                    "MACROEXPAND" "MACROEXPAND-1" "*MACROEXPAND-HOOK*"
                    "MAKE-LOAD-FORM"
                    "MAKE-LOAD-FORM-SAVING-SLOTS"
+                   "MASK-FIELD"
                    "PACKAGE" "PACKAGEP"
                    "PROCLAIM"
                    "SPECIAL-OPERATOR-P"
                    "TYPE-OF" "TYPEP"
                    "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"
+                         #!+mp "SB!MP"
+                         "SB!PCL"
+                         "SB!PRETTY"
+                         "SB!PROFILE"
+                         "SB!SYS"
+                         "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))
 
   ;; Build a version of Python to run in the host Common Lisp, to be
   ;; used only in cross-compilation.
index af914ef..f9b0161 100644 (file)
 (define-source-transform logtest (x y) `(not (zerop (logand ,x ,y))))
 (define-source-transform logbitp (index integer)
   `(not (zerop (logand (ash 1 ,index) ,integer))))
-(define-source-transform byte (size position) `(cons ,size ,position))
+(define-source-transform byte (size position)
+  `(cons ,size ,position))
 (define-source-transform byte-size (spec) `(car ,spec))
 (define-source-transform byte-position (spec) `(cdr ,spec))
 (define-source-transform ldb-test (bytespec integer)
index c41d1ba..9cdd7bb 100644 (file)
@@ -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.7.4.29"
+"0.7.4.30"