X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=0c575dcf339488fbd45a8ce98d2a3cb4d27ca369;hb=c1aeac123df223746249567a9c0d2f656d1222cb;hp=40478a59b4c5f3fd05a711b5d7d475e8b101cf6e;hpb=545fa4548b327804cf78afe38a2ecd94ced86162;p=sbcl.git diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 40478a5..0c575dc 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -12,7 +12,7 @@ ;;;; for !COLD-INIT to be called at cold load time. !COLD-INIT is ;;;; responsible for explicitly initializing anything which has to be ;;;; initialized early before it transfers control to the ordinary -;;;; top-level forms. +;;;; top level forms. ;;;; ;;;; (In CMU CL, and in SBCL as of 0.6.9 anyway, functions not defined ;;;; by DEFUN aren't set up specially by GENESIS. In particular, @@ -85,18 +85,18 @@ (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) + (name (missing-arg) :type symbol :read-only t) + (identifier (missing-arg) :type fixnum :read-only t) ;; the word address where the data will be loaded - (word-address (required-argument) :type unsigned-byte :read-only t) + (word-address (missing-arg) :type unsigned-byte :read-only t) ;; the data themselves. (Note that in CMU CL this was a pair ;; of fields SAP and WORDS-ALLOCATED, but that wasn't very portable.) (bytes (make-array target-space-alignment :element-type '(unsigned-byte 8)) :type (simple-array (unsigned-byte 8) 1)) ;; the index of the next unwritten word (i.e. chunk of - ;; SB!VM:WORD-BYTES bytes) in BYTES, or equivalently the number of + ;; SB!VM:N-WORD-BYTES bytes) in BYTES, or equivalently the number of ;; words actually written in BYTES. In order to convert to an actual - ;; index into BYTES, thus must be multiplied by SB!VM:WORD-BYTES. + ;; index into BYTES, thus must be multiplied by SB!VM:N-WORD-BYTES. (free-word-index 0)) (defun gspace-byte-address (gspace) @@ -160,7 +160,7 @@ (ash (descriptor-low des) (- 1 sb!vm:n-lowtag-bits))))) (format stream - "for fixnum: ~D" + "for fixnum: ~W" (if (> unsigned #x1FFFFFFF) (- unsigned #x40000000) unsigned)))) @@ -194,7 +194,7 @@ ;; NEW-FREE-WORD-INDEX. (do () ((>= (length (gspace-bytes gspace)) - (* new-free-word-index sb!vm:word-bytes))) + (* new-free-word-index sb!vm:n-word-bytes))) (expand-gspace-bytes gspace)) ;; Now that GSPACE is big enough, we can meaningfully grab a chunk of it. (setf (gspace-free-word-index gspace) new-free-word-index) @@ -285,7 +285,7 @@ (defun make-fixnum-descriptor (num) (when (>= (integer-length num) (1+ (- sb!vm:n-word-bits sb!vm:n-lowtag-bits))) - (error "~D is too big for a fixnum." num)) + (error "~W is too big for a fixnum." num)) (make-random-descriptor (ash num (1- sb!vm:n-lowtag-bits)))) (defun make-other-immediate-descriptor (data type) @@ -382,7 +382,7 @@ (defun maybe-byte-swap (word) (declare (type (unsigned-byte 32) word)) (aver (= sb!vm:n-word-bits 32)) - (aver (= sb!vm:byte-bits 8)) + (aver (= sb!vm:n-byte-bits 8)) (if (not *genesis-byte-order-swap-p*) word (logior (ash (ldb (byte 8 0) word) 24) @@ -393,7 +393,7 @@ (defun maybe-byte-swap-short (short) (declare (type (unsigned-byte 16) short)) (aver (= sb!vm:n-word-bits 32)) - (aver (= sb!vm:byte-bits 8)) + (aver (= sb!vm:n-byte-bits 8)) (if (not *genesis-byte-order-swap-p*) short (logior (ash (ldb (byte 8 0) short) 8) @@ -417,7 +417,7 @@ `(progn (defun ,name (byte-vector byte-index) (aver (= sb!vm:n-word-bits 32)) - (aver (= sb!vm:byte-bits 8)) + (aver (= sb!vm:n-byte-bits 8)) (ecase sb!c:*backend-byte-order* (:little-endian (logior ,@ash-list)) @@ -425,7 +425,7 @@ (error "stub: no big-endian ports of SBCL (yet?)")))) (defun (setf ,name) (new-value byte-vector byte-index) (aver (= sb!vm:n-word-bits 32)) - (aver (= sb!vm:byte-bits 8)) + (aver (= sb!vm:n-byte-bits 8)) (ecase sb!c:*backend-byte-order* (:little-endian (setf ,@setf-list)) @@ -521,9 +521,9 @@ "Allocate LENGTH units of ELEMENT-BITS bits plus a header word in GSPACE and return an ``other-pointer'' descriptor to them. Initialize the header word with the resultant length and TYPE." - (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits)) + (let* ((bytes (/ (* element-bits length) sb!vm:n-byte-bits)) (des (allocate-cold-descriptor gspace - (+ bytes sb!vm:word-bytes) + (+ bytes sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag))) (write-memory des (make-other-immediate-descriptor (ash bytes @@ -537,9 +537,9 @@ header word with TYPE and the length slot with LENGTH." ;; FIXME: Here and in ALLOCATE-UNBOXED-OBJECT, BYTES is calculated using ;; #'/ instead of #'CEILING, which seems wrong. - (let* ((bytes (/ (* element-bits length) sb!vm:byte-bits)) + (let* ((bytes (/ (* element-bits length) sb!vm:n-byte-bits)) (des (allocate-cold-descriptor gspace - (+ bytes (* 2 sb!vm:word-bytes)) + (+ bytes (* 2 sb!vm:n-word-bytes)) sb!vm:other-pointer-lowtag))) (write-memory des (make-other-immediate-descriptor 0 type)) (write-wordindexed des @@ -556,11 +556,11 @@ ;; extra null byte at the end to aid in call-out to C.) (let* ((length (length string)) (des (allocate-vector-object gspace - sb!vm:byte-bits + sb!vm:n-byte-bits (1+ length) sb!vm:simple-string-widetag)) (bytes (gspace-bytes gspace)) - (offset (+ (* sb!vm:vector-data-offset sb!vm:word-bytes) + (offset (+ (* sb!vm:vector-data-offset sb!vm:n-word-bytes) (descriptor-byte-offset des)))) (write-wordindexed des sb!vm:vector-length-slot @@ -593,7 +593,7 @@ ((> index words) (unless (zerop (integer-length remainder)) ;; FIXME: Shouldn't this be a fatal error? - (warn "~D words of ~D were written, but ~D bits were left over." + (warn "~W words of ~W were written, but ~W bits were left over." words n remainder))) (let ((word (ldb (byte sb!vm:n-word-bits 0) remainder))) (write-wordindexed handle index @@ -1062,7 +1062,7 @@ 0)) (result (make-descriptor (descriptor-high des) (+ (descriptor-low des) - (* 2 sb!vm:word-bytes) + (* 2 sb!vm:n-word-bytes) (- sb!vm:list-pointer-lowtag sb!vm:other-pointer-lowtag))))) (write-wordindexed des @@ -1108,7 +1108,7 @@ (descriptor-low *nil-descriptor*)))) (unless (= offset-wanted offset-found) ;; FIXME: should be fatal - (warn "Offset from ~S to ~S is ~D, not ~D" + (warn "Offset from ~S to ~S is ~W, not ~W" symbol nil offset-found @@ -1136,13 +1136,17 @@ ;;; intern it. (defun finish-symbols () - ;; FIXME: Why use SETQ (setting symbol value) instead of just using - ;; the function values for these things?? I.e. why do we need this - ;; section at all? Is it because all the FDEFINITION stuff gets in - ;; the way of reading function values and is too hairy to rely on at - ;; cold boot? FIXME: Most of these are in *STATIC-SYMBOLS* in - ;; parms.lisp, but %HANDLE-FUN-END-BREAKPOINT is not. Why? - ;; Explain. + ;; I think the point of setting these functions into SYMBOL-VALUEs + ;; here, instead of using SYMBOL-FUNCTION, is that in CMU CL + ;; SYMBOL-FUNCTION reduces to FDEFINITION, which is a pretty + ;; hairy operation (involving globaldb.lisp etc.) which we don't + ;; want to invoke early in cold init. -- WHN 2001-12-05 + ;; + ;; FIXME: So OK, that's a reasonable reason to do something weird like + ;; this, but this is still a weird thing to do, and we should change + ;; the names to highlight that something weird is going on. Perhaps + ;; *MAYBE-GC-FUN*, *INTERNAL-ERROR-FUN*, *HANDLE-BREAKPOINT-FUN*, + ;; and *HANDLE-FUN-END-BREAKPOINT-FUN*... (macrolet ((frob (symbol) `(cold-set ',symbol (cold-fdefinition-object (cold-intern ',symbol))))) @@ -1352,7 +1356,7 @@ (warm-symbol cadr-des)))) (#.sb!vm:other-pointer-lowtag (warm-symbol des))))) - (unless (legal-function-name-p result) + (unless (legal-fun-name-p result) (error "not a legal function name: ~S" result)) result)) @@ -1399,21 +1403,22 @@ sb!vm:word-shift)))) (#.sb!vm:closure-header-widetag (make-random-descriptor - (cold-foreign-symbol-address-as-integer "closure_tramp"))))) + (cold-foreign-symbol-address-as-integer + "closure_tramp"))))) fdefn)) (defun initialize-static-fns () (let ((*cold-fdefn-gspace* *static*)) - (dolist (sym sb!vm:*static-functions*) + (dolist (sym sb!vm:*static-funs*) (let* ((fdefn (cold-fdefinition-object (cold-intern sym))) (offset (- (+ (- (descriptor-low fdefn) sb!vm:other-pointer-lowtag) - (* sb!vm:fdefn-raw-addr-slot sb!vm:word-bytes)) + (* sb!vm:fdefn-raw-addr-slot sb!vm:n-word-bytes)) (descriptor-low *nil-descriptor*))) - (desired (sb!vm:static-function-offset sym))) + (desired (sb!vm:static-fun-offset sym))) (unless (= offset desired) ;; FIXME: should be fatal - (warn "Offset from FDEFN ~S to ~S is ~D, not ~D." + (warn "Offset from FDEFN ~S to ~S is ~W, not ~W." sym nil offset desired)))))) (defun list-all-fdefn-objects () @@ -1644,7 +1649,7 @@ (let ((fixed-up (- (+ value un-fixed-up) gspace-byte-address gspace-byte-offset - sb!vm:word-bytes))) ; length of CALL argument + sb!vm:n-word-bytes))) ; length of CALL argument (setf (byte-vector-ref-32 gspace-bytes gspace-byte-offset) fixed-up) ;; Note relative fixups that point outside the code @@ -1948,13 +1953,13 @@ (8 sb!vm:simple-array-unsigned-byte-8-widetag) (16 sb!vm:simple-array-unsigned-byte-16-widetag) (32 sb!vm:simple-array-unsigned-byte-32-widetag) - (t (error "losing element size: ~D" sizebits)))) + (t (error "losing element size: ~W" sizebits)))) (result (allocate-vector-object *dynamic* sizebits len type)) (start (+ (descriptor-byte-offset result) (ash sb!vm:vector-data-offset sb!vm:word-shift))) (end (+ start (ceiling (* len sizebits) - sb!vm:byte-bits)))) + sb!vm:n-byte-bits)))) (read-sequence-or-die (descriptor-bytes result) *fasl-input-stream* :start start @@ -1970,7 +1975,7 @@ 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:word-bytes)))) + (end (+ start (* len sb!vm:n-word-bytes)))) (read-sequence-or-die (descriptor-bytes result) *fasl-input-stream* :start start @@ -2303,10 +2308,10 @@ #!+sb-show (when *show-pre-fixup-code-p* (format *trace-output* - "~&/raw code from code-fop ~D ~D:~%" + "~&/raw code from code-fop ~W ~W:~%" nconst code-size) - (do ((i start (+ i sb!vm:word-bytes))) + (do ((i start (+ i sb!vm:n-word-bytes))) ((>= i end)) (format *trace-output* "/#X~8,'0x: #X~8,'0x~%" @@ -2636,7 +2641,7 @@ (format t "#define ~A_~A_OFFSET ~D~%" (substitute #\_ #\- (string name)) (substitute #\_ #\- (string (sb!vm:slot-name slot))) - (- (* (sb!vm:slot-offset slot) sb!vm:word-bytes) lowtag))) + (- (* (sb!vm:slot-offset slot) sb!vm:n-word-bytes) lowtag))) (terpri)))) (format t "#endif /* LANGUAGE_ASSEMBLY */~2%")) @@ -2654,7 +2659,7 @@ (descriptor-bits (cold-intern symbol)) ;; We didn't run GENESIS, so guess at the address. (+ sb!vm:static-space-start - sb!vm:word-bytes + sb!vm:n-word-bytes sb!vm:other-pointer-lowtag (if symbol (sb!vm:static-symbol-offset symbol) 0))))) @@ -2705,19 +2710,9 @@ that they were called before the out-of-line definition is installed, as is fairly common for structure accessors.) initially undefined function references:~2%") - (setf undefs (sort undefs #'string< :key #'function-name-block-name)) + (setf undefs (sort undefs #'string< :key #'fun-name-block-name)) (dolist (name undefs) - (format t "~S" name) - ;; FIXME: This ACCESSOR-FOR stuff should go away when the - ;; code has stabilized. (It's only here to help me - ;; categorize the flood of undefined functions caused by - ;; completely rewriting the bootstrap process. Hopefully any - ;; future maintainers will mostly have small numbers of - ;; undefined functions..) - (let ((accessor-for (info :function :accessor-for name))) - (when accessor-for - (format t " (accessor for ~S)" accessor-for))) - (format t "~%"))) + (format t "~S~%" name))) (format t "~%~|~%layout names:~2%") (collect ((stuff)) @@ -2766,7 +2761,7 @@ initially undefined function references:~2%") (defun output-gspace (gspace) (force-output *core-file*) (let* ((posn (file-position *core-file*)) - (bytes (* (gspace-free-word-index gspace) sb!vm:word-bytes)) + (bytes (* (gspace-free-word-index gspace) sb!vm:n-word-bytes)) (pages (ceiling bytes sb!c:*backend-page-size*)) (total-bytes (* pages sb!c:*backend-page-size*)))