Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory usw-pr-cvs1:/tmp/cvs-serv23790/src/compiler/generic
Modified Files:
genesis.lisp
Log Message:
0.7.2.10:
Merge APD fix for bug 151 (sbcl-devel 2002-04-12)
... add a test for #! being undefined
... note specialness of DIGIT-CHARs
Delete unused byte-swapping code from genesis (CSR
"My pending patches" sbcl-devel 2002-04-08)
Index: genesis.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v
retrieving revision 1.58
retrieving revision 1.59
diff -C2 -d -r1.58 -r1.59
*** genesis.lisp 19 Mar 2002 20:17:51 -0000 1.58
--- genesis.lisp 12 Apr 2002 12:15:56 -0000 1.59
***************
*** 345,374 ****
(defvar *cold-load-filename* nil)
(declaim (type (or string null) *cold-load-filename*))
-
- ;;; This is vestigial support for the CMU CL byte-swapping code. CMU
- ;;; CL code tested for whether it needed to swap bytes in GENESIS by
- ;;; comparing the byte order of *BACKEND* to the byte order of
- ;;; *NATIVE-BACKEND*, a concept which doesn't exist in SBCL. Instead,
- ;;; in SBCL byte order swapping would need to be explicitly requested
- ;;; with a &KEY argument to GENESIS.
- ;;;
- ;;; I'm not sure whether this is a problem or not, and I don't have a
- ;;; machine with different byte order to test to find out for sure.
- ;;; The version of the system which is fed to the cross-compiler is
- ;;; now written in a subset of Common Lisp which doesn't require
- ;;; dumping a lot of things in such a way that machine byte order
- ;;; matters. (Mostly this is a matter of not using any specialized
- ;;; array type unless there's portable, high-level code to dump it.)
- ;;; If it *is* a problem, and you're trying to resurrect this code,
- ;;; please test particularly carefully, since I haven't had a chance
- ;;; to test the byte-swapping code at all. -- WHN 19990816
- ;;;
- ;;; When this variable is non-NIL, byte-swapping is enabled wherever
- ;;; classic GENESIS would have done it. I.e. the value of this variable
- ;;; is the logical complement of
- ;;; (EQ (SB!C:BACKEND-BYTE-ORDER SB!C:*NATIVE-BACKEND*)
- ;;; (SB!C:BACKEND-BYTE-ORDER SB!C:*BACKEND*))
- ;;; from CMU CL.
- (defvar *genesis-byte-order-swap-p*)
;;;; miscellaneous stuff to read and write the core memory
--- 345,348 ----
***************
*** 380,403 ****
`(setq ,list (cold-cons ,thing ,list)))
- (defun maybe-byte-swap (word)
- (declare (type (unsigned-byte 32) word))
- (aver (= sb!vm:n-word-bits 32))
- (aver (= sb!vm:n-byte-bits 8))
- (if (not *genesis-byte-order-swap-p*)
- word
- (logior (ash (ldb (byte 8 0) word) 24)
- (ash (ldb (byte 8 8) word) 16)
- (ash (ldb (byte 8 16) word) 8)
- (ldb (byte 8 24) word))))
-
- (defun maybe-byte-swap-short (short)
- (declare (type (unsigned-byte 16) short))
- (aver (= sb!vm:n-word-bits 32))
- (aver (= sb!vm:n-byte-bits 8))
- (if (not *genesis-byte-order-swap-p*)
- short
- (logior (ash (ldb (byte 8 0) short) 8)
- (ldb (byte 8 8) short))))
-
;;; BYTE-VECTOR-REF-32 and friends. These are like SAP-REF-n, except
;;; that instead of a SAP we use a byte vector
--- 354,357 ----
***************
*** 450,458 ****
(byte-index (ash (+ index (descriptor-word-offset address))
sb!vm:word-shift))
! ;; KLUDGE: Do we really need to do byte swap here? It seems
! ;; as though we shouldn't.. (This attempts to be a literal
! ;; translation of CMU CL code, and I don't have a big-endian
! ;; machine to test it.) -- WHN 19990817
! (value (maybe-byte-swap (byte-vector-ref-32 bytes byte-index))))
(make-random-descriptor value)))
--- 404,408 ----
(byte-index (ash (+ index (descriptor-word-offset address))
sb!vm:word-shift))
! (value (byte-vector-ref-32 bytes byte-index)))
(make-random-descriptor value)))
***************
*** 494,506 ****
(ash index sb!vm:word-shift))
value)
- ;; Note: There's a MAYBE-BYTE-SWAP in here in CMU CL, which I
- ;; think is unnecessary now that we're doing the write
- ;; byte-by-byte at high level. (I can't test this, though..) --
- ;; WHN 19990817
(let* ((bytes (gspace-bytes (descriptor-intuit-gspace address)))
(byte-index (ash (+ index (descriptor-word-offset address))
sb!vm:word-shift)))
(setf (byte-vector-ref-32 bytes byte-index)
! (maybe-byte-swap (descriptor-bits value))))))
(declaim (ftype (function (descriptor descriptor)) write-memory))
--- 444,452 ----
(ash index sb!vm:word-shift))
value)
(let* ((bytes (gspace-bytes (descriptor-intuit-gspace address)))
(byte-index (ash (+ index (descriptor-word-offset address))
sb!vm:word-shift)))
(setf (byte-vector-ref-32 bytes byte-index)
! (descriptor-bits value)))))
(declaim (ftype (function (descriptor descriptor)) write-memory))
***************
*** 2952,2965 ****
;;; MAP-FILE-NAME gets (?) a map file. (dunno about this -- WHN 19990815)
;;;
- ;;; other arguments:
- ;;; BYTE-ORDER-SWAP-P controls whether GENESIS tries to swap bytes
- ;;; in some places in the output. It's only appropriate when
- ;;; cross-compiling from a machine with one byte order to a
- ;;; machine with the opposite byte order, which is irrelevant in
- ;;; current (19990816) SBCL, since only the X86 architecture is
- ;;; supported. If you're trying to add support for more
- ;;; architectures, see the comments on DEFVAR
- ;;; *GENESIS-BYTE-ORDER-SWAP-P* for more information.
- ;;;
;;; FIXME: GENESIS doesn't belong in SB!VM. Perhaps in %KERNEL for now,
;;; perhaps eventually in SB-LD or SB-BOOT.
--- 2898,2901 ----
***************
*** 2969,2974 ****
core-file-name
map-file-name
! c-header-file-name
! byte-order-swap-p)
(when (and core-file-name
--- 2905,2909 ----
core-file-name
map-file-name
! c-header-file-name)
(when (and core-file-name
***************
*** 3012,3016 ****
(let* ((*foreign-symbol-placeholder-value* (if core-file-name nil 0))
(*load-time-value-counter* 0)
- (*genesis-byte-order-swap-p* byte-order-swap-p)
(*cold-fdefn-objects* (make-hash-table :test 'equal))
(*cold-symbols* (make-hash-table :test 'equal))
--- 2947,2950 ----
|