;;; a GENESIS-time representation of a memory space (e.g. read-only space,
;;; dynamic space, or static space)
-(defstruct (gspace (:constructor %make-gspace))
+(defstruct (gspace (:constructor %make-gspace)
+ (:copier nil))
;; name and identifier for this GSPACE
(name (required-argument) :type symbol :read-only t)
(identifier (required-argument) :type fixnum :read-only t)
(defstruct (descriptor
(:constructor make-descriptor
- (high low &optional gspace word-offset)))
+ (high low &optional gspace word-offset))
+ (:copier nil))
;; 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
;;; 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 keyword argument to GENESIS.
+;;; 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.
(defun maybe-byte-swap (word)
(declare (type (unsigned-byte 32) word))
- (assert (= sb!vm:word-bits 32))
- (assert (= sb!vm:byte-bits 8))
+ (aver (= sb!vm:word-bits 32))
+ (aver (= sb!vm:byte-bits 8))
(if (not *genesis-byte-order-swap-p*)
word
(logior (ash (ldb (byte 8 0) word) 24)
(defun maybe-byte-swap-short (short)
(declare (type (unsigned-byte 16) short))
- (assert (= sb!vm:word-bits 32))
- (assert (= sb!vm:byte-bits 8))
+ (aver (= sb!vm:word-bits 32))
+ (aver (= sb!vm:byte-bits 8))
(if (not *genesis-byte-order-swap-p*)
short
(logior (ash (ldb (byte 8 0) short) 8)
;;; like SAP-REF-32, except that instead of a SAP we use a byte vector
(defun byte-vector-ref-32 (byte-vector byte-index)
- (assert (= sb!vm:word-bits 32))
- (assert (= sb!vm:byte-bits 8))
+ (aver (= sb!vm:word-bits 32))
+ (aver (= sb!vm:byte-bits 8))
(ecase sb!c:*backend-byte-order*
(:little-endian
(logior (ash (aref byte-vector (+ byte-index 0)) 0)
(:big-endian
(error "stub: no big-endian ports of SBCL (yet?)"))))
(defun (setf byte-vector-ref-32) (new-value byte-vector byte-index)
- (assert (= sb!vm:word-bits 32))
- (assert (= sb!vm:byte-bits 8))
+ (aver (= sb!vm:word-bits 32))
+ (aver (= sb!vm:byte-bits 8))
(ecase sb!c:*backend-byte-order*
(:little-endian
(setf (aref byte-vector (+ byte-index 0)) (ldb (byte 8 0) new-value)
\f
;;;; symbol magic
-;;; FIXME: This should be a keyword argument of ALLOCATE-SYMBOL.
+;;; FIXME: This should be a &KEY argument of ALLOCATE-SYMBOL.
(defvar *cold-symbol-allocation-gspace* nil)
;;; Allocate (and initialize) a symbol.
(#.sb!c:pmax-fasl-file-implementation
(ecase kind
(:jump
- (assert (zerop (ash value -28)))
+ (aver (zerop (ash value -28)))
(setf (ldb (byte 26 0) (sap-ref-32 sap 0))
(ash value -2)))
(:lui
gspace-byte-offset))
(code-object-start-addr (logandc2 (descriptor-bits code-object)
sb!vm:lowtag-mask)))
- (assert (= code-object-start-addr
- (+ gspace-byte-address
- (descriptor-byte-offset code-object))))
+ (aver (= code-object-start-addr
+ (+ gspace-byte-address
+ (descriptor-byte-offset code-object))))
(ecase kind
(:absolute
(let ((fixed-up (+ value un-fixed-up)))
(logand inst #xffffc000)))
(:load-short
(let ((low-bits (ldb (byte 11 0) value)))
- (assert (<= 0 low-bits (1- (ash 1 4))))
+ (aver (<= 0 low-bits (1- (ash 1 4))))
(logior (ash low-bits 17)
(logand inst #xffe0ffff))))
(:hi
(logand inst #xffe00000)))
(:branch
(let ((bits (ldb (byte 9 2) value)))
- (assert (zerop (ldb (byte 2 0) value)))
+ (aver (zerop (ldb (byte 2 0) value)))
(logior (ash bits 3)
(logand inst #xffe0e002)))))))))
(#.sb!c:alpha-fasl-file-implementation
(ecase kind
(:jmp-hint
- (assert (zerop (ldb (byte 2 0) value)))
+ (aver (zerop (ldb (byte 2 0) value)))
#+nil
(setf (sap-ref-16 sap 0)
(logior (sap-ref-16 sap 0) (ldb (byte 14 0) (ash value -2)))))
(#.sb!c:sgi-fasl-file-implementation
(ecase kind
(:jump
- (assert (zerop (ash value -28)))
+ (aver (zerop (ash value -28)))
(setf (ldb (byte 26 0) (sap-ref-32 sap 0))
(ash value -2)))
(:lui
(defvar *normal-fop-functions*)
-;;; This is like DEFINE-FOP which defines fops for warm load, but unlike
-;;; DEFINE-FOP, this version
-;;; (1) looks up the code for this name (created by a previous DEFINE-FOP)
-;;; instead of creating a code, and
-;;; (2) stores its definition in the *COLD-FOP-FUNCTIONS* vector, instead
-;;; of storing in the *FOP-FUNCTIONS* vector.
+;;; Cause a fop to have a special definition for cold load.
+;;;
+;;; This is similar to DEFINE-FOP, but unlike DEFINE-FOP, this version
+;;; (1) looks up the code for this name (created by a previous
+;; DEFINE-FOP) instead of creating a code, and
+;;; (2) stores its definition in the *COLD-FOP-FUNCTIONS* vector,
+;;; instead of storing in the *FOP-FUNCTIONS* vector.
(defmacro define-cold-fop ((name &optional (pushp t)) &rest forms)
(check-type pushp (member nil t :nope))
(let ((code (get name 'fop-code))
- (fname (concat-pnames 'cold- name)))
+ (fname (symbolicate "COLD-" name)))
(unless code
(error "~S is not a defined FOP." name))
`(progn
`(define-cold-fop (,name)
(error "The fop ~S is not supported in cold load." ',name)))
-;;; COLD-LOAD loads stuff into the core image being built by calling FASLOAD
-;;; with the fop function table rebound to a table of cold loading functions.
+;;; COLD-LOAD loads stuff into the core image being built by calling
+;;; FASLOAD with the fop function table rebound to a table of cold
+;;; loading functions.
(defun cold-load (filename)
#!+sb-doc
"Load the file named by FILENAME into the cold load image being built."
(declare (type index old-length))
(declare (type fixnum old-depthoid))
(declare (type list old-inherits-list))
- (assert (eq name old-name))
+ (aver (eq name old-name))
(let ((length (descriptor-fixnum length-des))
(inherits-list (listify-cold-inherits cold-inherits))
(depthoid (descriptor-fixnum depthoid-des)))
;; less expensively (ERROR, not CERROR), and which reports
;; "internal error" on failure. Use it here and elsewhere in the
;; system.
- (assert (zerop rem))
+ (aver (zerop rem))
(write-long floor))
(write-long pages)
;; much. (And the old CMU CL code is still useful for making
;; sure that the appropriate keywords and internal symbols end
;; up interned in the target Lisp, which is good, e.g. in order
- ;; to make keyword arguments work right and in order to make
+ ;; to make &KEY arguments work right and in order to make
;; BACKTRACEs into target Lisp system code be legible.)
(dolist (exported-name
(sb-cold:read-from-file "common-lisp-exports.lisp-expr"))
projects / sbcl.git / blobdiff