Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/code
In directory usw-pr-cvs1:/tmp/cvs-serv1093/src/code

Modified Files:
	cross-make-load-form.lisp cross-misc.lisp 
Added Files:
	cross-byte.lisp 
Log Message:
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


--- NEW FILE: cross-byte.lisp ---
;;;; 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: cross-make-load-form.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/cross-make-load-form.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- cross-make-load-form.lisp	30 May 2002 12:30:53 -0000	1.1
+++ cross-make-load-form.lisp	13 Jun 2002 08:54:37 -0000	1.2
@@ -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: cross-misc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/cross-misc.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- cross-misc.lisp	31 Oct 2001 19:42:57 -0000	1.5
+++ cross-misc.lisp	13 Jun 2002 08:54:37 -0000	1.6
@@ -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))