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
;;; 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)
--- /dev/null
+;;;; 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)))))
;;;
;;; 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))
(let ((result 0))
(declare (type fixnum result))
(do-external-symbols (i package)
- (declare (ignore i))
+ (declare (ignorable i))
(incf result))
result))
;; 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.
(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)
;;; 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"