;;; (dump-integer-as-n-bytes total-length 2 file))
;;; (t
;;; (dump-fop 'sb!impl::fop-code file)
-;;; (dump-unsigned-32 num-consts file)
-;;; (dump-unsigned-32 total-length file))))
+;;; (dump-word num-consts file)
+;;; (dump-word total-length file))))
;;; in several places. It would be cleaner if this could be replaced with
;;; something like
;;; (dump-fop file fop-code num-consts total-length)
(aver (member pushp '(nil t)))
(aver (member stackp '(nil t)))
`(progn
- (macrolet ((clone-arg () '(read-arg 4)))
+ (macrolet ((clone-arg () '(read-word-arg)))
(define-fop (,name ,code :pushp ,pushp :stackp ,stackp) ,@forms))
- (macrolet ((clone-arg () '(read-arg 1)))
+ (macrolet ((clone-arg () '(read-byte-arg)))
(define-fop (,small-name ,small-code :pushp ,pushp :stackp stackp) ,@forms))))
;;; a helper function for reading string values from FASL files: sort
;; It was changed for SBCL because we needed a portable version for
;; bootstrapping. Benchmark the non-portable version and see whether it's
;; significantly better than the portable version here. If it is, then use
- ;; add as an alternate definition, protected with #-SB-XC-HOST.
+ ;; it as an alternate definition, protected with #-SB-XC-HOST.
(values))
\f
;;;; miscellaneous fops
(define-fop (fop-nop 0 :stackp nil))
(define-fop (fop-pop 1 :pushp nil) (push-fop-table (pop-stack)))
-(define-fop (fop-push 2) (svref *current-fop-table* (read-arg 4)))
-(define-fop (fop-byte-push 3) (svref *current-fop-table* (read-arg 1)))
+(define-fop (fop-push 2) (svref *current-fop-table* (read-word-arg)))
+(define-fop (fop-byte-push 3) (svref *current-fop-table* (read-byte-arg)))
(define-fop (fop-empty-list 4) ())
(define-fop (fop-truth 5) t)
;;; SBCL as we have no extended characters, only 1-byte characters.
;;; (Ditto for CMU CL, actually: FOP-CHARACTER was speculative generality.)
(define-fop (fop-short-character 69)
- (code-char (read-arg 1)))
+ (code-char (read-byte-arg)))
(define-cloned-fops (fop-struct 48) (fop-small-struct 49)
(let* ((size (clone-arg))
(define-fop (fop-maybe-cold-load 82 :stackp nil))
(define-fop (fop-verify-table-size 62 :stackp nil)
- (let ((expected-index (read-arg 4)))
+ (let ((expected-index (read-word-arg)))
(unless (= *current-fop-table-index* expected-index)
(bug "fasl table of improper size"))))
(define-fop (fop-verify-empty-stack 63 :stackp nil)
;;(frob fop-symbol-save 6 4 *package*)
;;(frob fop-small-symbol-save 7 1 *package*)
- (frob fop-lisp-symbol-save 75 4 *cl-package*)
+ (frob fop-lisp-symbol-save 75 #.sb!vm:n-word-bytes *cl-package*)
(frob fop-lisp-small-symbol-save 76 1 *cl-package*)
- (frob fop-keyword-symbol-save 77 4 *keyword-package*)
+ (frob fop-keyword-symbol-save 77 #.sb!vm:n-word-bytes *keyword-package*)
(frob fop-keyword-small-symbol-save 78 1 *keyword-package*)
;; FIXME: Because we don't have FOP-SYMBOL-SAVE any more, an enormous number
;; fasl files. A new
;; FOP-SYMBOL-IN-LAST-PACKAGE-SAVE/FOP-SMALL-SYMBOL-IN-LAST-PACKAGE-SAVE
;; cloned fop pair could undo some of this bloat.
- (frob fop-symbol-in-package-save 8 4
- (svref *current-fop-table* (fast-read-u-integer 4)))
+ (frob fop-symbol-in-package-save 8 #.sb!vm:n-word-bytes
+ (svref *current-fop-table* (fast-read-u-integer #.sb!vm:n-word-bytes)))
(frob fop-small-symbol-in-package-save 9 1
- (svref *current-fop-table* (fast-read-u-integer 4)))
- (frob fop-symbol-in-byte-package-save 10 4
+ (svref *current-fop-table* (fast-read-u-integer #.sb!vm:n-word-bytes)))
+ (frob fop-symbol-in-byte-package-save 10 #.sb!vm:n-word-bytes
(svref *current-fop-table* (fast-read-u-integer 1)))
(frob fop-small-symbol-in-byte-package-save 11 1
(svref *current-fop-table* (fast-read-u-integer 1))))
(define-fop (fop-word-integer 35)
(prepare-for-fast-read-byte *fasl-input-stream*
(prog1
- (fast-read-s-integer 4)
+ (fast-read-s-integer #.sb!vm:n-word-bytes)
(done-with-fast-read-byte))))
(define-fop (fop-byte-integer 36)
(define-fop (fop-list 15)
(do ((res () (cons (pop-stack) res))
- (n (read-arg 1) (1- n)))
+ (n (read-byte-arg) (1- n)))
((zerop n) res)
(declare (type index n))))
(define-fop (fop-list* 16)
(do ((res (pop-stack) (cons (pop-stack) res))
- (n (read-arg 1) (1- n)))
+ (n (read-byte-arg) (1- n)))
((zerop n) res)
(declare (type index n))))
res))
(define-fop (fop-array 83)
- (let* ((rank (read-arg 4))
+ (let* ((rank (read-word-arg))
(vec (pop-stack))
(length (length vec))
(res (make-array-header sb!vm:simple-array-widetag rank)))
(declare (simple-array vec)
- (type (unsigned-byte 24) rank))
+ (type (unsigned-byte #.(- sb!vm:n-word-bits sb!vm:n-widetag-bits)) rank))
(set-array-header res vec length nil 0
(do ((i rank (1- i))
(dimensions () (cons (pop-stack) dimensions)))
res))
(define-fop (fop-single-float-vector 84)
- (let* ((length (read-arg 4))
+ (let* ((length (read-word-arg))
(result (make-array length :element-type 'single-float)))
- (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes))
+ (read-n-bytes *fasl-input-stream* result 0 (* length 4))
result))
(define-fop (fop-double-float-vector 85)
- (let* ((length (read-arg 4))
+ (let* ((length (read-word-arg))
(result (make-array length :element-type 'double-float)))
- (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2))
+ (read-n-bytes *fasl-input-stream* result 0 (* length 8))
result))
(define-fop (fop-complex-single-float-vector 86)
- (let* ((length (read-arg 4))
+ (let* ((length (read-word-arg))
(result (make-array length :element-type '(complex single-float))))
- (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2))
+ (read-n-bytes *fasl-input-stream* result 0 (* length 8))
result))
(define-fop (fop-complex-double-float-vector 87)
- (let* ((length (read-arg 4))
+ (let* ((length (read-word-arg))
(result (make-array length :element-type '(complex double-float))))
- (read-n-bytes *fasl-input-stream*
- result
- 0
- (* length sb!vm:n-word-bytes 2 2))
+ (read-n-bytes *fasl-input-stream* result 0 (* length 16))
result))
;;; CMU CL comment:
;;; byte-ordering, allowing us to directly read the bits.
(define-fop (fop-int-vector 43)
(prepare-for-fast-read-byte *fasl-input-stream*
- (let* ((len (fast-read-u-integer 4))
+ (let* ((len (fast-read-u-integer #.sb!vm:n-word-bytes))
(size (fast-read-byte))
(res (case size
(0 (make-array len :element-type 'nil))
(31 (prog1 (make-array len :element-type '(unsigned-byte 31))
(setf size 32)))
(32 (make-array len :element-type '(unsigned-byte 32)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ (63 (prog1 (make-array len :element-type '(unsigned-byte 63))
+ (setf size 64)))
+ (64 (make-array len :element-type '(unsigned-byte 64)))
(t (bug "losing i-vector element size: ~S" size)))))
(declare (type index len))
(done-with-fast-read-byte)
(read-n-bytes *fasl-input-stream*
res
0
- (ceiling (the index (* size len))
- sb!vm:n-byte-bits))
+ (ceiling (the index (* size len)) sb!vm:n-byte-bits))
res)))
;;; This is the same as FOP-INT-VECTOR, except this is for signed
;;; SIMPLE-ARRAYs.
(define-fop (fop-signed-int-vector 50)
(prepare-for-fast-read-byte *fasl-input-stream*
- (let* ((len (fast-read-u-integer 4))
+ (let* ((len (fast-read-u-integer #.sb!vm:n-word-bytes))
(size (fast-read-byte))
(res (case size
(8 (make-array len :element-type '(signed-byte 8)))
(16 (make-array len :element-type '(signed-byte 16)))
- (29 (make-array len :element-type '(unsigned-byte 29)))
- (30 (make-array len :element-type '(signed-byte 30)))
+ #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+ (29 (prog1 (make-array len :element-type '(unsigned-byte 29))
+ (setf size 32)))
+ #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+ (30 (prog1 (make-array len :element-type '(signed-byte 30))
+ (setf size 32)))
(32 (make-array len :element-type '(signed-byte 32)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ (60 (prog1 (make-array len :element-type '(unsigned-byte 60))
+ (setf size 64)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ (61 (prog1 (make-array len :element-type '(signed-byte 61))
+ (setf size 64)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ (64 (make-array len :element-type '(signed-byte 64)))
(t (bug "losing si-vector element size: ~S" size)))))
(declare (type index len))
(done-with-fast-read-byte)
(read-n-bytes *fasl-input-stream*
res
0
- (ceiling (the index (* (if (or (= size 30) (= size 29))
- 32 ; Adjust for (signed-byte 30)
- size) len)) sb!vm:n-byte-bits))
+ (ceiling (the index (* size len)) sb!vm:n-byte-bits))
res)))
(define-fop (fop-eval 53)
(terpri))))
(define-fop (fop-funcall 55)
- (let ((arg (read-arg 1)))
+ (let ((arg (read-byte-arg)))
(if (zerop arg)
(funcall (pop-stack))
(do ((args () (cons (pop-stack) args))
(declare (type index n))))))
(define-fop (fop-funcall-for-effect 56 :pushp nil)
- (let ((arg (read-arg 1)))
+ (let ((arg (read-byte-arg)))
(if (zerop arg)
(funcall (pop-stack))
(do ((args () (cons (pop-stack) args))
;;;; fops for fixing up circularities
(define-fop (fop-rplaca 200 :pushp nil)
- (let ((obj (svref *current-fop-table* (read-arg 4)))
- (idx (read-arg 4))
+ (let ((obj (svref *current-fop-table* (read-word-arg)))
+ (idx (read-word-arg))
(val (pop-stack)))
(setf (car (nthcdr idx obj)) val)))
(define-fop (fop-rplacd 201 :pushp nil)
- (let ((obj (svref *current-fop-table* (read-arg 4)))
- (idx (read-arg 4))
+ (let ((obj (svref *current-fop-table* (read-word-arg)))
+ (idx (read-word-arg))
(val (pop-stack)))
(setf (cdr (nthcdr idx obj)) val)))
(define-fop (fop-svset 202 :pushp nil)
- (let* ((obi (read-arg 4))
+ (let* ((obi (read-word-arg))
(obj (svref *current-fop-table* obi))
- (idx (read-arg 4))
+ (idx (read-word-arg))
(val (pop-stack)))
(if (typep obj 'instance)
(setf (%instance-ref obj idx) val)
(setf (svref obj idx) val))))
(define-fop (fop-structset 204 :pushp nil)
- (setf (%instance-ref (svref *current-fop-table* (read-arg 4))
- (read-arg 4))
+ (setf (%instance-ref (svref *current-fop-table* (read-word-arg))
+ (read-word-arg))
(pop-stack)))
;;; In the original CMUCL code, this actually explicitly declared PUSHP
;;; to be T, even though that's what it defaults to in DEFINE-FOP.
(define-fop (fop-nthcdr 203)
- (nthcdr (read-arg 4) (pop-stack)))
+ (nthcdr (read-word-arg) (pop-stack)))
\f
;;;; fops for loading functions
;;; fasl file header.)
(define-fop (fop-code 58 :stackp nil)
- (load-code (read-arg 4) (read-arg 4)))
+ (load-code (read-word-arg) (read-word-arg)))
(define-fop (fop-small-code 59 :stackp nil)
- (load-code (read-arg 1) (read-arg 2)))
+ (load-code (read-byte-arg) (read-halfword-arg)))
(define-fop (fop-fdefinition 60)
(fdefinition-object (pop-stack) t))
(arglist (pop-stack))
(name (pop-stack))
(code-object (pop-stack))
- (offset (read-arg 4)))
+ (offset (read-word-arg)))
(declare (type index offset))
(unless (zerop (logand offset sb!vm:lowtag-mask))
(bug "unaligned function object, offset = #X~X" offset))
(define-fop (fop-foreign-fixup 147)
(let* ((kind (pop-stack))
(code-object (pop-stack))
- (len (read-arg 1))
+ (len (read-byte-arg))
(sym (make-string len)))
(read-n-bytes *fasl-input-stream* sym 0 len)
(sb!vm:fixup-code-object code-object
- (read-arg 4)
+ (read-word-arg)
(foreign-symbol-address-as-integer sym)
kind)
code-object))
(multiple-value-bind (value found) (gethash routine *assembler-routines*)
(unless found
(error "undefined assembler routine: ~S" routine))
- (sb!vm:fixup-code-object code-object (read-arg 4) value kind))
+ (sb!vm:fixup-code-object code-object (read-word-arg) value kind))
code-object))
(define-fop (fop-code-object-fixup 149)
;; Note: We don't have to worry about GC moving the code-object after
;; the GET-LISP-OBJ-ADDRESS and before that value is deposited, because
;; we can only use code-object fixups when code-objects don't move.
- (sb!vm:fixup-code-object code-object (read-arg 4)
+ (sb!vm:fixup-code-object code-object (read-word-arg)
(get-lisp-obj-address code-object) kind)
code-object))
#!-sb-fluid (declaim (inline read-byte))
+;;; FIXME: why do all of these reading functions and macros declare
+;;; (SPEED 0)? was there some bug in the compiler which has since
+;;; been fixed? --njf, 2004-09-08
+
;;; This expands into code to read an N-byte unsigned integer using
;;; FAST-READ-BYTE.
(defmacro fast-read-u-integer (n)
(cnt 1 (1+ cnt)))
((>= cnt n) res))))
-;;; Read an N-byte unsigned integer from the *FASL-INPUT-STREAM*
+;;; Read an N-byte unsigned integer from the *FASL-INPUT-STREAM*.
(defmacro read-arg (n)
(declare (optimize (speed 0)))
(if (= n 1)
(fast-read-u-integer ,n)
(done-with-fast-read-byte)))))
-;;; FIXME: This deserves a more descriptive name, and should probably
-;;; be implemented as an ordinary function, not a macro.
-;;;
-;;; (for the names: There seem to be only two cases, so it could be
-;;; named READ-U-INTEGER-8 and READ-U-INTEGER-32 or something.)
+(declaim (inline read-byte-arg read-halfword-arg read-word-arg))
+(defun read-byte-arg ()
+ (declare (optimize (speed 0)))
+ (read-arg 1))
+
+(defun read-halfword-arg ()
+ (declare (optimize (speed 0)))
+ (read-arg #.(/ sb!vm:n-word-bytes 2)))
+
+(defun read-word-arg ()
+ (declare (optimize (speed 0)))
+ (read-arg #.sb!vm:n-word-bytes))
+
\f
;;;; the fop table
;; Read and validate version-specific compatibility stuff.
(flet ((string-from-stream ()
- (let* ((length (read-arg 4))
+ (let* ((length (read-word-arg))
(result (make-string length)))
(read-string-as-bytes stream result)
result)))
(let* ((implementation (keywordicate (string-from-stream)))
;; FIXME: The logic above to read a keyword from the fasl file
;; could probably be shared with the read-a-keyword fop.
- (version (read-arg 4)))
+ (version (read-word-arg)))
(flet ((check-version (variant
possible-implementation
needed-version)
(declare (type (unsigned-byte 8) b) (type fasl-output fasl-output))
(write-byte b (fasl-output-stream fasl-output)))
-;;; Dump a 4 byte unsigned integer.
-(defun dump-unsigned-32 (num fasl-output)
- (declare (type (unsigned-byte 32) num))
+;; Dump a word-sized integer.
+(defun dump-word (num fasl-output)
+ (declare (type sb!vm:word num))
(declare (type fasl-output fasl-output))
(let ((stream (fasl-output-stream fasl-output)))
- (dotimes (i 4)
+ (dotimes (i sb!vm:n-word-bytes)
(write-byte (ldb (byte 8 (* 8 i)) num) stream))))
;;; Dump NUM to the fasl stream, represented by N bytes. This works
#!+sb-show
(when *fop-nop4-count*
(dump-byte ,(get 'fop-nop4 'fop-code) ,file)
- (dump-unsigned-32 (mod (incf *fop-nop4-count*) (expt 2 32)) ,file))
+ (dump-integer-as-n-bytes (mod (incf *fop-nop4-count*) (expt 2 32))
+ 4 ,file))
(dump-byte ',val ,file))
(error "compiler bug: ~S is not a legal fasload operator." fs))))
(dump-byte ,n-n ,n-file))
(t
(dump-fop ',word-fop ,n-file)
- (dump-unsigned-32 ,n-n ,n-file)))))
+ (dump-word ,n-n ,n-file)))))
;;; Push the object at table offset Handle on the fasl stack.
(defun dump-push (handle fasl-output)
;; Finish the header by outputting fasl file implementation,
;; version, and key *FEATURES*.
(flet ((dump-counted-string (string)
- (dump-unsigned-32 (length string) res)
+ (dump-word (length string) res)
(dotimes (i (length string))
(dump-byte (char-code (aref string i)) res))))
(dump-counted-string (symbol-name +backend-fasl-file-implementation+))
- (dump-unsigned-32 +fasl-file-version+ res)
+ (dump-word +fasl-file-version+ res)
(dump-counted-string *features-affecting-fasl-format*))
res))
;; End the group.
(dump-fop 'fop-verify-empty-stack fasl-output)
(dump-fop 'fop-verify-table-size fasl-output)
- (dump-unsigned-32 (fasl-output-table-free fasl-output)
+ (dump-word (fasl-output-table-free fasl-output)
fasl-output)
(dump-fop 'fop-end-group fasl-output)
(i 0 (1+ i)))
((eq current value)
(dump-fop 'fop-nthcdr file)
- (dump-unsigned-32 i file))
+ (dump-word i file))
(declare (type index i)))))
(ecase (circularity-type info)
(:rplacd (dump-fop 'fop-rplacd file))
(:svset (dump-fop 'fop-svset file))
(:struct-set (dump-fop 'fop-structset file)))
- (dump-unsigned-32 (gethash (circularity-object info) table) file)
- (dump-unsigned-32 (circularity-index info) file))))
+ (dump-word (gethash (circularity-object info) table) file)
+ (dump-word (circularity-index info) file))))
;;; Set up stuff for circularity detection, then dump an object. All
;;; shared and circular structure will be exactly preserved within a
((signed-byte 8)
(dump-fop 'fop-byte-integer file)
(dump-byte (logand #xFF n) file))
- ((unsigned-byte 31)
+ ((unsigned-byte #.(1- sb!vm:n-word-bits))
(dump-fop 'fop-word-integer file)
- (dump-unsigned-32 n file))
- ((signed-byte 32)
+ (dump-word n file))
+ ((signed-byte #.sb!vm:n-word-bits)
(dump-fop 'fop-word-integer file)
- (dump-integer-as-n-bytes n 4 file))
+ (dump-integer-as-n-bytes n #.sb!vm:n-word-bytes file))
(t
(let ((bytes (ceiling (1+ (integer-length n)) 8)))
(dump-fop* bytes fop-small-integer fop-integer file)
(dump-fop 'fop-double-float file)
(let ((x x))
(declare (double-float x))
- ;; FIXME: Why sometimes DUMP-UNSIGNED-32 and sometimes
- ;; DUMP-INTEGER-AS-N-BYTES .. 4?
- (dump-unsigned-32 (double-float-low-bits x) file)
+ (dump-integer-as-n-bytes (double-float-low-bits x) 4 file)
(dump-integer-as-n-bytes (double-float-high-bits x) 4 file)))
#!+long-float
(long-float
(dump-fop 'fop-complex-double-float file)
(let ((re (realpart x)))
(declare (double-float re))
- (dump-unsigned-32 (double-float-low-bits re) file)
+ (dump-integer-as-n-bytes (double-float-low-bits re) 4 file)
(dump-integer-as-n-bytes (double-float-high-bits re) 4 file))
(let ((im (imagpart x)))
(declare (double-float im))
- (dump-unsigned-32 (double-float-low-bits im) file)
+ (dump-integer-as-n-bytes (double-float-low-bits im) 4 file)
(dump-integer-as-n-bytes (double-float-high-bits im) 4 file)))
#!+long-float
((complex long-float)
(labels ((dump-unsigned-vector (size bytes)
(unless data-only
(dump-fop 'fop-int-vector file)
- (dump-unsigned-32 len file)
+ (dump-word len file)
(dump-byte size file))
;; The case which is easy to handle in a portable way is when
;; the element size is a multiple of the output byte size, and
;; target machine.)
(unless data-only
(dump-fop 'fop-signed-int-vector file)
- (dump-unsigned-32 len file)
+ (dump-word len file)
(dump-byte size file))
(dump-raw-bytes vec bytes file)))
(etypecase vec
#-sb-xc-host
((simple-array nil (*))
(dump-unsigned-vector 0 0))
- ;; KLUDGE: What exactly does the (ASH .. -3) stuff do? -- WHN 19990902
(simple-bit-vector
- (dump-unsigned-vector 1 (ash (+ (the index len) 7) -3)))
+ (dump-unsigned-vector 1 (ceiling len 8)))
;; KLUDGE: This isn't the best way of expressing that the host
;; may not have specializations for (unsigned-byte 2) and
;; (unsigned-byte 4), which means that these types are
;; CSR, 2002-05-07
#-sb-xc-host
((simple-array (unsigned-byte 2) (*))
- (dump-unsigned-vector 2 (ash (+ (the index (ash len 1)) 7) -3)))
+ (dump-unsigned-vector 2 (ceiling len 8)))
#-sb-xc-host
((simple-array (unsigned-byte 4) (*))
- (dump-unsigned-vector 4 (ash (+ (the index (ash len 2)) 7) -3)))
+ (dump-unsigned-vector 4 (ceiling len 8)))
#-sb-xc-host
((simple-array (unsigned-byte 7) (*))
(dump-unsigned-vector 7 len))
(dump-unsigned-vector 31 (* 4 len)))
((simple-array (unsigned-byte 32) (*))
(dump-unsigned-vector 32 (* 4 len)))
+ #-sb-xc-host
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ ((simple-array (unsigned-byte-63) (*))
+ (dump-unsigned-vector 63 (* 8 len)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ ((simple-array (unsigned-byte-64) (*))
+ (dump-unsigned-vector 64 (* 8 len)))
((simple-array (signed-byte 8) (*))
(dump-signed-vector 8 len))
((simple-array (signed-byte 16) (*))
(dump-signed-vector 16 (* 2 len)))
+ #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
((simple-array (unsigned-byte 29) (*))
(dump-signed-vector 29 (* 4 len)))
+ #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
((simple-array (signed-byte 30) (*))
(dump-signed-vector 30 (* 4 len)))
((simple-array (signed-byte 32) (*))
- (dump-signed-vector 32 (* 4 len)))))))
+ (dump-signed-vector 32 (* 4 len)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ ((simple-array (unsigned-byte 60) (*))
+ (dump-signed-vector 60 (* 8 len)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ ((simple-array (signed-byte 61) (*))
+ (dump-signed-vector 61 (* 8 len)))
+ #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+ ((simple-array (signed-byte 64) (*))
+ (dump-signed-vector 64 (* 8 len)))))))
\f
;;; Dump characters and string-ish things.
fop-symbol-in-byte-package-save
fop-symbol-in-package-save
file)
- (dump-unsigned-32 pname-length file)))
+ (dump-word pname-length file)))
(dump-characters-of-string pname file)
(aver (null name))
(dump-fop 'fop-code-object-fixup fasl-output)))
;; No matter what the flavor, we'll always dump the position
- (dump-unsigned-32 position fasl-output)))
+ (dump-word position fasl-output)))
(values))
;;; Dump out the constant pool and code-vector for component, push the
(dump-integer-as-n-bytes total-length 2 fasl-output))
(t
(dump-fop 'fop-code fasl-output)
- (dump-unsigned-32 num-consts fasl-output)
- (dump-unsigned-32 total-length fasl-output))))
+ (dump-word num-consts fasl-output)
+ (dump-word total-length fasl-output))))
;; These two dumps are only ones which contribute to our
;; TOTAL-LENGTH value.
(defun dump-assembler-routines (code-segment length fixups routines file)
(dump-fop 'fop-assembler-code file)
- (dump-unsigned-32 length file)
+ (dump-word length file)
(write-segment-contents code-segment (fasl-output-stream file))
(dolist (routine routines)
(dump-fop 'fop-normal-load file)
(dump-object (car routine) file))
(dump-fop 'fop-maybe-cold-load file)
(dump-fop 'fop-assembler-routine file)
- (dump-unsigned-32 (label-position (cdr routine)) file))
+ (dump-word (label-position (cdr routine)) file))
(dump-fixups fixups file)
(dump-fop 'fop-sanctify-for-execution file)
(dump-pop file))
(dump-object (sb!c::entry-info-arguments entry) file)
(dump-object (sb!c::entry-info-type entry) file)
(dump-fop 'fop-fun-entry file)
- (dump-unsigned-32 (label-position (sb!c::entry-info-offset entry)) file)
+ (dump-word (label-position (sb!c::entry-info-offset entry)) file)
(dump-pop file)))
;;; Alter the code object referenced by CODE-HANDLE at the specified
(dump-fop 'fop-verify-empty-stack file)
(dump-fop 'fop-verify-table-size file)
- (dump-unsigned-32 (fasl-output-table-free file) file)
+ (dump-word (fasl-output-table-free file) file)
#!+sb-dyncount
(let ((info (sb!c::ir2-component-dyncount-info (component-info component))))
(dolist (info-handle (fasl-output-debug-info fasl-output))
(dump-push res-handle fasl-output)
(dump-fop 'fop-structset fasl-output)
- (dump-unsigned-32 info-handle fasl-output)
- (dump-unsigned-32 2 fasl-output))))
+ (dump-word info-handle fasl-output)
+ ;; FIXME: what is this bare `2'? --njf, 2004-08-16
+ (dump-word 2 fasl-output))))
(setf (fasl-output-debug-info fasl-output) nil)
(values))
\f
;; the GSPACE that this descriptor is allocated in, or NIL if not set yet.
(gspace nil :type (or gspace null))
;; the offset in words from the start of GSPACE, or NIL if not set yet
- (word-offset nil :type (or (unsigned-byte #.sb!vm:n-word-bits) null))
+ (word-offset nil :type (or sb!vm:word null))
;; the high and low halves of the descriptor
;;
;; KLUDGE: Judging from the comments in genesis.lisp of the CMU CL
(aver (member pushp '(nil t)))
(aver (member stackp '(nil t)))
`(progn
- (macrolet ((clone-arg () '(read-arg 4)))
+ (macrolet ((clone-arg () '(read-word-arg)))
(define-cold-fop (,name :pushp ,pushp :stackp ,stackp) ,@forms))
- (macrolet ((clone-arg () '(read-arg 1)))
+ (macrolet ((clone-arg () '(read-byte-arg)))
(define-cold-fop (,small-name :pushp ,pushp :stackp ,stackp) ,@forms))))
;;; Cause a fop to be undefined in cold load.
(define-cold-fop (fop-misc-trap) *unbound-marker*)
(define-cold-fop (fop-short-character)
- (make-character-descriptor (read-arg 1)))
+ (make-character-descriptor (read-byte-arg)))
(define-cold-fop (fop-empty-list) *nil-descriptor*)
(define-cold-fop (fop-truth) (cold-intern t))
(push-fop-table
(cold-load-symbol (read-arg ,pname-len)
(svref *current-fop-table* index)))))))
- (frob fop-symbol-in-package-save 4 4)
- (frob fop-small-symbol-in-package-save 1 4)
- (frob fop-symbol-in-byte-package-save 4 1)
+ (frob fop-symbol-in-package-save #.sb!vm:n-word-bytes #.sb!vm:n-word-bytes)
+ (frob fop-small-symbol-in-package-save 1 #.sb!vm:n-word-bytes)
+ (frob fop-symbol-in-byte-package-save #.sb!vm:n-word-bytes 1)
(frob fop-small-symbol-in-byte-package-save 1 1))
(clone-cold-fop (fop-lisp-symbol-save)
(declare (fixnum index))))
(define-cold-fop (fop-list)
- (cold-stack-list (read-arg 1) *nil-descriptor*))
+ (cold-stack-list (read-byte-arg) *nil-descriptor*))
(define-cold-fop (fop-list*)
- (cold-stack-list (read-arg 1) (pop-stack)))
+ (cold-stack-list (read-byte-arg) (pop-stack)))
(define-cold-fop (fop-list-1)
(cold-stack-list 1 *nil-descriptor*))
(define-cold-fop (fop-list-2)
result))
(define-cold-fop (fop-int-vector)
- (let* ((len (read-arg 4))
- (sizebits (read-arg 1))
+ (let* ((len (read-word-arg))
+ (sizebits (read-byte-arg))
(type (case sizebits
(0 sb!vm:simple-array-nil-widetag)
(1 sb!vm:simple-bit-vector-widetag)
(63 (prog1 sb!vm:simple-array-unsigned-byte-63-widetag
(setf sizebits 64)))
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
- (64 (sb!vm:simple-array-unsigned-byte-64-widetag))
+ (64 sb!vm:simple-array-unsigned-byte-64-widetag)
(t (error "losing element size: ~W" sizebits))))
(result (allocate-vector-object *dynamic* sizebits len type))
(start (+ (descriptor-byte-offset result)
result))
(define-cold-fop (fop-single-float-vector)
- (let* ((len (read-arg 4))
+ (let* ((len (read-word-arg))
(result (allocate-vector-object
*dynamic*
sb!vm:n-word-bits
sb!vm:simple-array-single-float-widetag))
(start (+ (descriptor-byte-offset result)
(ash sb!vm:vector-data-offset sb!vm:word-shift)))
- (end (+ start (* len sb!vm:n-word-bytes))))
+ (end (+ start (* len 4))))
(read-bigvec-as-sequence-or-die (descriptor-bytes result)
*fasl-input-stream*
:start start
#!+long-float (not-cold-fop fop-complex-long-float-vector)
(define-cold-fop (fop-array)
- (let* ((rank (read-arg 4))
+ (let* ((rank (read-word-arg))
(data-vector (pop-stack))
(result (allocate-boxed-object *dynamic*
(+ sb!vm:array-dimensions-offset rank)
(defvar *load-time-value-counter*)
(define-cold-fop (fop-funcall)
- (unless (= (read-arg 1) 0)
+ (unless (= (read-byte-arg) 0)
(error "You can't FOP-FUNCALL arbitrary stuff in cold load."))
(let ((counter *load-time-value-counter*))
(cold-push (cold-cons
sb!vm:simple-vector-widetag)))
(define-cold-fop (fop-funcall-for-effect :pushp nil)
- (if (= (read-arg 1) 0)
+ (if (= (read-byte-arg) 0)
(cold-push (pop-stack)
*current-reversed-cold-toplevels*)
(error "You can't FOP-FUNCALL arbitrary stuff in cold load.")))
;;;; cold fops for fixing up circularities
(define-cold-fop (fop-rplaca :pushp nil)
- (let ((obj (svref *current-fop-table* (read-arg 4)))
- (idx (read-arg 4)))
+ (let ((obj (svref *current-fop-table* (read-word-arg)))
+ (idx (read-word-arg)))
(write-memory (cold-nthcdr idx obj) (pop-stack))))
(define-cold-fop (fop-rplacd :pushp nil)
- (let ((obj (svref *current-fop-table* (read-arg 4)))
- (idx (read-arg 4)))
+ (let ((obj (svref *current-fop-table* (read-word-arg)))
+ (idx (read-word-arg)))
(write-wordindexed (cold-nthcdr idx obj) 1 (pop-stack))))
(define-cold-fop (fop-svset :pushp nil)
- (let ((obj (svref *current-fop-table* (read-arg 4)))
- (idx (read-arg 4)))
+ (let ((obj (svref *current-fop-table* (read-word-arg)))
+ (idx (read-word-arg)))
(write-wordindexed obj
(+ idx
(ecase (descriptor-lowtag obj)
(pop-stack))))
(define-cold-fop (fop-structset :pushp nil)
- (let ((obj (svref *current-fop-table* (read-arg 4)))
- (idx (read-arg 4)))
+ (let ((obj (svref *current-fop-table* (read-word-arg)))
+ (idx (read-word-arg)))
(write-wordindexed obj (1+ idx) (pop-stack))))
;;; In the original CMUCL code, this actually explicitly declared PUSHP
;;; to be T, even though that's what it defaults to in DEFINE-COLD-FOP.
(define-cold-fop (fop-nthcdr)
- (cold-nthcdr (read-arg 4) (pop-stack)))
+ (cold-nthcdr (read-word-arg) (pop-stack)))
(defun cold-nthcdr (index obj)
(dotimes (i index)
(bvref-32 (descriptor-bytes des) i)))))
des)))
-(define-cold-code-fop fop-code (read-arg 4) (read-arg 4))
+(define-cold-code-fop fop-code (read-word-arg) (read-word-arg))
-(define-cold-code-fop fop-small-code (read-arg 1) (read-arg 2))
+(define-cold-code-fop fop-small-code (read-byte-arg) (read-halfword-arg))
(clone-cold-fop (fop-alter-code :pushp nil)
(fop-byte-alter-code)
(arglist (pop-stack))
(name (pop-stack))
(code-object (pop-stack))
- (offset (calc-offset code-object (read-arg 4)))
+ (offset (calc-offset code-object (read-word-arg)))
(fn (descriptor-beyond code-object
offset
sb!vm:fun-pointer-lowtag))
(define-cold-fop (fop-foreign-fixup)
(let* ((kind (pop-stack))
(code-object (pop-stack))
- (len (read-arg 1))
+ (len (read-byte-arg))
(sym (make-string len)))
(read-string-as-bytes *fasl-input-stream* sym)
- (let ((offset (read-arg 4))
+ (let ((offset (read-word-arg))
(value (cold-foreign-symbol-address-as-integer sym)))
(do-cold-fixup code-object offset value kind))
code-object))
(define-cold-fop (fop-assembler-code)
- (let* ((length (read-arg 4))
+ (let* ((length (read-word-arg))
(header-n-words
;; Note: we round the number of constants up to ensure that
;; the code vector will be properly aligned.
(define-cold-fop (fop-assembler-routine)
(let* ((routine (pop-stack))
(des (pop-stack))
- (offset (calc-offset des (read-arg 4))))
+ (offset (calc-offset des (read-word-arg))))
(record-cold-assembler-routine
routine
(+ (logandc2 (descriptor-bits des) sb!vm:lowtag-mask) offset))
(let* ((routine (pop-stack))
(kind (pop-stack))
(code-object (pop-stack))
- (offset (read-arg 4)))
+ (offset (read-word-arg)))
(record-cold-assembler-fixup routine code-object offset kind)
code-object))
(define-cold-fop (fop-code-object-fixup)
(let* ((kind (pop-stack))
(code-object (pop-stack))
- (offset (read-arg 4))
+ (offset (read-word-arg))
(value (descriptor-bits code-object)))
(do-cold-fixup code-object offset value kind)
code-object))
(sub-dump-object vector file)
(sub-dump-object (subseq vector start end) file)))
(dump-fop 'fop-array file)
- (dump-unsigned-32 rank file)
+ (dump-word rank file)
(eq-save-object array file)))
\f
;;;; various dump-a-number operations
(defun dump-single-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-single-float-vector file)
- (dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:n-word-bytes) file)))
+ (dump-word length file)
+ (dump-raw-bytes vec (* length 4) file)))
(defun dump-double-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-double-float-vector file)
- (dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:n-word-bytes 2) file)))
+ (dump-word length file)
+ (dump-raw-bytes vec (* length 8) file)))
#!+long-float
(defun dump-long-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-long-float-vector file)
- (dump-unsigned-32 length file)
+ (dump-word length file)
(dump-raw-bytes vec
(* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4)
file)))
(defun dump-complex-single-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-complex-single-float-vector file)
- (dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:n-word-bytes 2) file)))
+ (dump-word length file)
+ (dump-raw-bytes vec (* length 8) file)))
(defun dump-complex-double-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-complex-double-float-vector file)
- (dump-unsigned-32 length file)
- (dump-raw-bytes vec (* length sb!vm:n-word-bytes 2 2) file)))
+ (dump-word length file)
+ (dump-raw-bytes vec (* length 16) file)))
#!+long-float
(defun dump-complex-long-float-vector (vec file)
(let ((length (length vec)))
(dump-fop 'fop-complex-long-float-vector file)
- (dump-unsigned-32 length file)
+ (dump-word length file)
(dump-raw-bytes vec
(* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4 2)
file)))
(let ((exp-bits (long-float-exp-bits float))
(high-bits (long-float-high-bits float))
(low-bits (long-float-low-bits float)))
- (dump-unsigned-32 low-bits file)
- (dump-unsigned-32 high-bits file)
+ ;; We could get away with DUMP-WORD here, since the x86 has 4-byte words,
+ ;; but we prefer to make things as explicit as possible.
+ ;; --njf, 2004-08-16
+ (dump-integer-as-n-bytes low-bits 4 file)
+ (dump-integer-as-n-bytes high-bits 4 file)
(dump-integer-as-n-bytes exp-bits 2 file)))
#!+(and long-float sparc)
(high-bits (long-float-high-bits float))
(mid-bits (long-float-mid-bits float))
(low-bits (long-float-low-bits float)))
- (dump-unsigned-32 low-bits file)
- (dump-unsigned-32 mid-bits file)
- (dump-unsigned-32 high-bits file)
+ ;; We could get away with DUMP-WORD here, since the sparc has 4-byte
+ ;; words, but we prefer to make things as explicit as possible.
+ ;; --njf, 2004-08-16
+ (dump-integer-as-n-bytes low-bits 4 file)
+ (dump-integer-as-n-bytes mid-bits 4 file)
+ (dump-integer-as-n-bytes high-bits 4 file)
(dump-integer-as-n-bytes exp-bits 4 file)))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.14.2"
+"0.8.14.3"
projects / sbcl.git / commitdiff