From 2e91e29892268b2c7e5ab557e8192fa03bce68f2 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 13 Jun 2002 08:54:37 +0000 Subject: [PATCH] 0.7.4.30: 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 | 1 + src/code/cross-byte.lisp | 70 +++++++++++++++++++++++++++ src/code/cross-make-load-form.lisp | 3 ++ src/code/cross-misc.lisp | 2 +- src/cold/defun-load-or-cload-xcompiler.lisp | 35 ++++++++++++++ src/compiler/srctran.lisp | 3 +- version.lisp-expr | 2 +- 7 files changed, 113 insertions(+), 3 deletions(-) create mode 100644 src/code/cross-byte.lisp diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 1e5b578..86e1c98 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -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 index 0000000..b9b8178 --- /dev/null +++ b/src/code/cross-byte.lisp @@ -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))))) diff --git a/src/code/cross-make-load-form.lisp b/src/code/cross-make-load-form.lisp index 7e26e75..22bde12 100644 --- a/src/code/cross-make-load-form.lisp +++ b/src/code/cross-make-load-form.lisp @@ -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)) diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index 7a4152e..df93d81 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -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)) diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp index 8fcc696..cadc1b9 100644 --- a/src/cold/defun-load-or-cload-xcompiler.lisp +++ b/src/cold/defun-load-or-cload-xcompiler.lisp @@ -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" @@ -102,14 +103,17 @@ "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" @@ -119,6 +123,37 @@ "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. diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index af914ef..f9b0161 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -180,7 +180,8 @@ (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) diff --git a/version.lisp-expr b/version.lisp-expr index c41d1ba..9cdd7bb 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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" -- 1.7.10.4