X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdump.lisp;h=d17167cf5dc1e8f73e6e818eefd8af9b7fc49156;hb=4cf50b1896b25f5337e7c258b0b560da00d47993;hp=672c196870f17eb0416fa3d90218696ae1f74017;hpb=9266ac18b62c73bff89a0f45165cf740b3c87ca1;p=sbcl.git diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index 672c196..d17167c 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -25,10 +25,11 @@ #-no-ansi-print-object (:print-object (lambda (x s) (print-unreadable-object (x s :type t) - (prin1 (namestring (fasl-file-stream x)) s))))) - ;; The stream we dump to. + (prin1 (namestring (fasl-file-stream x)) s)))) + (:copier nil)) + ;; the stream we dump to (stream (required-argument) :type stream) - ;; Hashtables we use to keep track of dumped constants so that we + ;; hashtables we use to keep track of dumped constants so that we ;; can get them from the table rather than dumping them again. The ;; EQUAL-TABLE is used for lists and strings, and the EQ-TABLE is ;; used for everything else. We use a separate EQ table to avoid @@ -37,7 +38,7 @@ ;; the EQ table. (equal-table (make-hash-table :test 'equal) :type hash-table) (eq-table (make-hash-table :test 'eq) :type hash-table) - ;; The table's current free pointer: the next offset to be used. + ;; the table's current free pointer: the next offset to be used (table-free 0 :type index) ;; an alist (PACKAGE . OFFSET) of the table offsets for each package ;; we have currently located. @@ -69,7 +70,7 @@ (valid-structures (make-hash-table :test 'eq) :type hash-table)) ;;; This structure holds information about a circularity. -(defstruct circularity +(defstruct (circularity (:copier nil)) ;; the kind of modification to make to create circularity (type (required-argument) :type (member :rplaca :rplacd :svset :struct-set)) ;; the object containing circularity @@ -111,10 +112,10 @@ (dotimes (i 4) (write-byte (ldb (byte 8 (* 8 i)) num) stream)))) -;;; Dump NUM to the fasl stream, represented by N bytes. This works for either -;;; signed or unsigned integers. There's no range checking -- if you don't -;;; specify enough bytes for the number to fit, this function cheerfully -;;; outputs the low bytes. +;;; Dump NUM to the fasl stream, represented by N bytes. This works +;;; for either signed or unsigned integers. There's no range checking +;;; -- if you don't specify enough bytes for the number to fit, this +;;; function cheerfully outputs the low bytes. (defun dump-integer-as-n-bytes (num bytes file) (declare (integer num) (type index bytes) (type fasl-file file)) (do ((n num (ash n -8)) @@ -124,23 +125,22 @@ (dump-byte (logand n #xff) file)) (values)) -;;; Setting this variable to an (UNSIGNED-BYTE 32) value causes DUMP-FOP to use -;;; it as a counter and emit a FOP-NOP4 with the counter value before every -;;; ordinary fop. This can make it easier to follow the progress of FASLOAD -;;; when debugging/testing/experimenting. -#!+sb-show (defvar *fop-nop4-count* 0) +;;; Setting this variable to an (UNSIGNED-BYTE 32) value causes +;;; DUMP-FOP to use it as a counter and emit a FOP-NOP4 with the +;;; counter value before every ordinary fop. This can make it easier +;;; to follow the progress of LOAD-AS-FASL when +;;; debugging/testing/experimenting. +#!+sb-show (defvar *fop-nop4-count* nil) #!+sb-show (declaim (type (or (unsigned-byte 32) null) *fop-nop4-count*)) -;;; FIXME: The default value here should become NIL once I get the system to -;;; run. ;;; Dump the FOP code for the named FOP to the specified fasl-file. ;;; -;;; FIXME: This should be a function, with a compiler macro expansion for the -;;; common constant-FS case. (Among other things, that'll stop it from -;;; EVALing ,FILE multiple times.) +;;; FIXME: This should be a function, with a compiler macro expansion +;;; for the common constant-FS case. (Among other things, that'll stop +;;; it from EVALing ,FILE multiple times.) ;;; -;;; FIXME: Compiler macros, frozen classes, inlining, and similar optimizations -;;; should be conditional on #!+SB-FROZEN. +;;; FIXME: Compiler macros, frozen classes, inlining, and similar +;;; optimizations should be conditional on #!+SB-FROZEN. (defmacro dump-fop (fs file) (let* ((fs (eval fs)) (val (get fs 'sb!impl::fop-code))) @@ -153,11 +153,11 @@ (dump-byte ',val ,file)) (error "compiler bug: ~S is not a legal fasload operator." fs)))) -;;; Dump a FOP-Code along with an integer argument, choosing the FOP based -;;; on whether the argument will fit in a single byte. +;;; Dump a FOP-Code along with an integer argument, choosing the FOP +;;; based on whether the argument will fit in a single byte. ;;; -;;; FIXME: This, like DUMP-FOP, should be a function with a compiler-macro -;;; expansion. +;;; FIXME: This, like DUMP-FOP, should be a function with a +;;; compiler-macro expansion. (defmacro dump-fop* (n byte-fop word-fop file) (once-only ((n-n n) (n-file file)) @@ -226,7 +226,7 @@ (defun note-potential-circularity (x file) (unless *cold-load-dump* (let ((circ (fasl-file-circularity-table file))) - (assert (not (gethash x circ))) + (aver (not (gethash x circ))) (setf (gethash x circ) x))) (values)) @@ -297,7 +297,7 @@ ;;; We do various sanity checks, then end the group. (defun close-fasl-file (file abort-p) (declare (type fasl-file file)) - (assert (zerop (hash-table-count (fasl-file-patch-table file)))) + (aver (zerop (hash-table-count (fasl-file-patch-table file)))) (dump-fop 'sb!impl::fop-verify-empty-stack file) (dump-fop 'sb!impl::fop-verify-table-size file) (dump-unsigned-32 (fasl-file-table-free file) file) @@ -307,21 +307,6 @@ ;;;; main entries to object dumping -;;; KLUDGE: This definition doesn't really belong in this file, but at -;;; least it can be compiled without error here, and it's used here. -;;; The definition requires the IGNORE-ERRORS macro, and in -;;; sbcl-0.6.8.11 that's defined in early-target-error.lisp, and all -;;; of the files which would otherwise be natural homes for this -;;; definition (e.g. early-extensions.lisp or late-extensions.lisp) -;;; are compiled before early-target-error.lisp. -- WHN 2000-11-07 -(defun circular-list-p (list) - (and (listp list) - (multiple-value-bind (res condition) - (ignore-errors (list-length list)) - (if condition - nil - (null res))))) - ;;; This function deals with dumping objects that are complex enough ;;; so that we want to cache them in the table, rather than repeatedly ;;; dumping them. If the object is in the EQ-TABLE, then we push it, @@ -351,12 +336,12 @@ ;; So if better list coalescing is needed, start here. ;; -- WHN 2000-11-07 (if (circular-list-p x) - (progn - (dump-list x file) - (eq-save-object x file)) - (unless (equal-check-table x file) - (dump-list x file) - (equal-save-object x file)))) + (progn + (dump-list x file) + (eq-save-object x file)) + (unless (equal-check-table x file) + (dump-list x file) + (equal-save-object x file)))) (layout (dump-layout x file) (eq-save-object x file)) @@ -402,7 +387,7 @@ (if (eq x t) (dump-fop 'sb!impl::fop-truth file) (dump-non-immediate-object x file))) - ((target-fixnump x) (dump-integer x file)) + ((fixnump x) (dump-integer x file)) ((characterp x) (dump-character x file)) (t (dump-non-immediate-object x file)))) @@ -457,18 +442,19 @@ ;;;; LOAD-TIME-VALUE and MAKE-LOAD-FORM support -;;; Emit a funcall of the function and return the handle for the result. +;;; Emit a funcall of the function and return the handle for the +;;; result. (defun fasl-dump-load-time-value-lambda (fun file) (declare (type clambda fun) (type fasl-file file)) (let ((handle (gethash (leaf-info fun) (fasl-file-entry-table file)))) - (assert handle) + (aver handle) (dump-push handle file) (dump-fop 'sb!impl::fop-funcall file) (dump-byte 0 file)) (dump-pop file)) -;;; Return T iff CONSTANT has not already been dumped. It's been dumped -;;; if it's in the EQ table. +;;; Return T iff CONSTANT has not already been dumped. It's been +;;; dumped if it's in the EQ table. (defun fasl-constant-already-dumped (constant file) (if (or (gethash constant (fasl-file-eq-table file)) (gethash constant (fasl-file-valid-structures file))) @@ -484,23 +470,21 @@ (setf (gethash constant table) handle)) (values)) -;;; Note that the specified structure can just be dumped by enumerating the -;;; slots. +;;; Note that the specified structure can just be dumped by +;;; enumerating the slots. (defun fasl-validate-structure (structure file) (setf (gethash structure (fasl-file-valid-structures file)) t) (values)) ;;;; number dumping -;;; Dump a ratio - +;;; Dump a ratio. (defun dump-ratio (x file) (sub-dump-object (numerator x) file) (sub-dump-object (denominator x) file) (dump-fop 'sb!impl::fop-ratio file)) ;;; Dump an integer. - (defun dump-integer (n file) (typecase n ((signed-byte 8) @@ -569,12 +553,13 @@ ;;;; symbol dumping ;;; Return the table index of PKG, adding the package to the table if -;;; necessary. During cold load, we read the string as a normal string so that -;;; we can do the package lookup at cold load time. +;;; necessary. During cold load, we read the string as a normal string +;;; so that we can do the package lookup at cold load time. ;;; -;;; KLUDGE: Despite the parallelism in names, the functionality of this -;;; function is not parallel to other functions DUMP-FOO, e.g. DUMP-SYMBOL -;;; and DUMP-LIST. -- WHN 19990119 +;;; FIXME: Despite the parallelism in names, the functionality of +;;; this function is not parallel to other functions DUMP-FOO, e.g. +;;; DUMP-SYMBOL and DUMP-LIST. The mapping between names and behavior +;;; should be made more consistent. (defun dump-package (pkg file) (declare (type package pkg) (type fasl-file file) (values index) (inline assoc)) @@ -610,8 +595,8 @@ ;;; Marking of the conses is inhibited when *COLD-LOAD-DUMP* is true. ;;; This inhibits all circularity detection. (defun dump-list (list file) - (assert (and list - (not (gethash list (fasl-file-circularity-table file))))) + (aver (and list + (not (gethash list (fasl-file-circularity-table file))))) (do* ((l list (cdr l)) (n 0 (1+ n)) (circ (fasl-file-circularity-table file))) @@ -668,7 +653,8 @@ (dump-fop 'sb!impl::fop-list* file) (dump-byte 255 file))))) -;;; If N > 255, must build list with one list operator, then list* operators. +;;; If N > 255, must build list with one LIST operator, then LIST* +;;; operators. (defun terminate-undotted-list (n file) (declare (type index n) (type fasl-file file)) @@ -702,8 +688,9 @@ (dump-vector x file) (dump-multi-dim-array x file))) -;;; Dump the vector object. If it's not simple, then actually dump a simple -;;; version of it. But we enter the original in the EQ or EQUAL tables. +;;; Dump the vector object. If it's not simple, then actually dump a +;;; simple version of it. But we enter the original in the EQ or EQUAL +;;; tables. (defun dump-vector (x file) (let ((simple-version (if (array-header-p x) (coerce x 'simple-array) @@ -782,16 +769,17 @@ ;; unportable bit bashing. (cond ((>= size 8) ; easy cases (multiple-value-bind (floor rem) (floor size 8) - (assert (zerop rem)) + (aver (zerop rem)) (dovector (i vec) (dump-integer-as-n-bytes i floor file)))) (t ; harder cases, not supported in cross-compiler (dump-raw-bytes vec bytes file)))) (dump-signed-vector (size bytes) - ;; Note: Dumping specialized signed vectors isn't supported in - ;; the cross-compiler. (All cases here end up trying to call - ;; DUMP-RAW-BYTES, which isn't provided in the cross-compilation - ;; host, only on the target machine.) + ;; Note: Dumping specialized signed vectors isn't + ;; supported in the cross-compiler. (All cases here end + ;; up trying to call DUMP-RAW-BYTES, which isn't + ;; provided in the cross-compilation host, only on the + ;; target machine.) (unless data-only (dump-fop 'sb!impl::fop-signed-int-vector file) (dump-unsigned-32 len file) @@ -914,11 +902,12 @@ (error "internal error, code-length=~D, nwritten=~D" code-length nwritten))) - ;; KLUDGE: It's not clear what this is trying to do, but it looks as though - ;; it's an implicit undocumented dependence on a 4-byte wordsize which could - ;; be painful in porting. Note also that there are other undocumented - ;; modulo-4 things scattered throughout the code and conditionalized - ;; with GENGC, and I don't know what those do either. -- WHN 19990323 + ;; KLUDGE: It's not clear what this is trying to do, but it looks as + ;; though it's an implicit undocumented dependence on a 4-byte + ;; wordsize which could be painful in porting. Note also that there + ;; are other undocumented modulo-4 things scattered throughout the + ;; code and conditionalized with GENGC, and I don't know what those + ;; do either. -- WHN 19990323 #!+gengc (unless (zerop (logand code-length 3)) (dotimes (i (- 4 (logand code-length 3))) (dump-byte 0 fasl-file))) @@ -932,19 +921,19 @@ (declare (list fixups) (type fasl-file fasl-file)) (dolist (info fixups) ;; FIXME: Packing data with LIST in NOTE-FIXUP and unpacking them - ;; with FIRST, SECOND, and THIRD here is hard to follow and maintain. - ;; Perhaps we could define a FIXUP-INFO structure to use instead, and - ;; rename *FIXUPS* to *FIXUP-INFO-LIST*? + ;; with FIRST, SECOND, and THIRD here is hard to follow and + ;; maintain. Perhaps we could define a FIXUP-INFO structure to use + ;; instead, and rename *FIXUPS* to *FIXUP-INFO-LIST*? (let* ((kind (first info)) (fixup (second info)) (name (fixup-name fixup)) (flavor (fixup-flavor fixup)) (offset (third info))) - ;; FIXME: This OFFSET is not what's called OFFSET in - ;; the FIXUP structure, it's what's called POSN in NOTE-FIXUP. - ;; (As far as I can tell, FIXUP-OFFSET is not actually an offset, - ;; it's an internal label used instead of NAME for :CODE-OBJECT - ;; fixups. Notice that in the :CODE-OBJECT case, NAME is ignored.) + ;; FIXME: This OFFSET is not what's called OFFSET in the FIXUP + ;; structure, it's what's called POSN in NOTE-FIXUP. (As far as + ;; I can tell, FIXUP-OFFSET is not actually an offset, it's an + ;; internal label used instead of NAME for :CODE-OBJECT fixups. + ;; Notice that in the :CODE-OBJECT case, NAME is ignored.) (dump-fop 'sb!impl::fop-normal-load fasl-file) (let ((*cold-load-dump* t)) (dump-object kind fasl-file)) @@ -953,22 +942,22 @@ ;; noise before the offset. (ecase flavor (:assembly-routine - (assert (symbolp name)) + (aver (symbolp name)) (dump-fop 'sb!impl::fop-normal-load fasl-file) (let ((*cold-load-dump* t)) (dump-object name fasl-file)) (dump-fop 'sb!impl::fop-maybe-cold-load fasl-file) (dump-fop 'sb!impl::fop-assembler-fixup fasl-file)) (:foreign - (assert (stringp name)) + (aver (stringp name)) (dump-fop 'sb!impl::fop-foreign-fixup fasl-file) (let ((len (length name))) - (assert (< len 256)) ; (limit imposed by fop definition) + (aver (< len 256)) ; (limit imposed by fop definition) (dump-byte len fasl-file) (dotimes (i len) (dump-byte (char-code (schar name i)) fasl-file)))) (:code-object - (assert (null name)) + (aver (null name)) (dump-fop 'sb!impl::fop-code-object-fixup fasl-file))) ;; No matter what the flavor, we'll always dump the offset. (dump-unsigned-32 offset fasl-file))) @@ -977,12 +966,13 @@ ;;; Dump out the constant pool and code-vector for component, push the ;;; result in the table, and return the offset. ;;; -;;; The only tricky thing is handling constant-pool references to functions. -;;; If we have already dumped the function, then we just push the code pointer. -;;; Otherwise, we must create back-patching information so that the constant -;;; will be set when the function is eventually dumped. This is a bit awkward, -;;; since we don't have the handle for the code object being dumped while we -;;; are dumping its constants. +;;; The only tricky thing is handling constant-pool references to +;;; functions. If we have already dumped the function, then we just +;;; push the code pointer. Otherwise, we must create back-patching +;;; information so that the constant will be set when the function is +;;; eventually dumped. This is a bit awkward, since we don't have the +;;; handle for the code object being dumped while we are dumping its +;;; constants. ;;; ;;; We dump trap objects in any unused slots or forward referenced slots. (defun dump-code-object (component @@ -1017,9 +1007,12 @@ ;; Dump the offset of the trace table. (dump-object code-length fasl-file) - ;; KLUDGE: Now that we don't have GENGC, the trace table is hardwired - ;; to be empty. Could we get rid of trace tables? What are the - ;; virtues of GENGC vs. GENCGC vs. whatnot? + ;; FIXME: As long as we don't have GENGC, the trace table is + ;; hardwired to be empty. So we might be able to get rid of + ;; trace tables? However, we should probably wait for the first + ;; port to a system where CMU CL uses GENGC to see whether GENGC + ;; is really gone. (I.e. maybe other non-X86 ports will want to + ;; use it, just as in CMU CL.) ;; Dump the constants, noting any :entries that have to be fixed up. (do ((i sb!vm:code-constants-offset (1+ i))) @@ -1072,14 +1065,14 @@ (dump-unsigned-32 num-consts fasl-file) (dump-unsigned-32 total-length fasl-file)))) - ;; These two dumps are only ones which contribute to our TOTAL-LENGTH - ;; value. + ;; These two dumps are only ones which contribute to our + ;; TOTAL-LENGTH value. (dump-segment code-segment code-length fasl-file) (dump-i-vector packed-trace-table fasl-file :data-only t) - ;; DUMP-FIXUPS does its own internal DUMP-FOPs: the bytes it dumps aren't - ;; included in the TOTAL-LENGTH passed to our FOP-CODE/FOP-SMALL-CODE - ;; fop. + ;; DUMP-FIXUPS does its own internal DUMP-FOPs: the bytes it + ;; dumps aren't included in the TOTAL-LENGTH passed to our + ;; FOP-CODE/FOP-SMALL-CODE fop. (dump-fixups fixups fasl-file) (dump-fop 'sb!impl::fop-sanctify-for-execution fasl-file) @@ -1106,12 +1099,13 @@ (dump-fop 'sb!impl::fop-sanctify-for-execution file) (dump-pop file)) -;;; Dump a function-entry data structure corresponding to Entry to File. -;;; Code-Handle is the table offset of the code object for the component. +;;; Dump a function-entry data structure corresponding to ENTRY to +;;; FILE. CODE-HANDLE is the table offset of the code object for the +;;; component. ;;; -;;; If the entry is a DEFUN, then we also dump a FOP-FSET so that the cold -;;; loader can instantiate the definition at cold-load time, allowing forward -;;; references to functions in top-level forms. +;;; If the entry is a DEFUN, then we also dump a FOP-FSET so that the +;;; cold loader can instantiate the definition at cold-load time, +;;; allowing forward references to functions in top-level forms. (defun dump-one-entry (entry code-handle file) (declare (type entry-info entry) (type index code-handle) (type fasl-file file)) @@ -1129,8 +1123,8 @@ (dump-fop 'sb!impl::fop-fset file)) handle))) -;;; Alter the code object referenced by Code-Handle at the specified Offset, -;;; storing the object referenced by Entry-Handle. +;;; Alter the code object referenced by CODE-HANDLE at the specified +;;; OFFSET, storing the object referenced by ENTRY-HANDLE. (defun dump-alter-code-object (code-handle offset entry-handle file) (declare (type index code-handle entry-handle offset) (type fasl-file file)) (dump-push code-handle file) @@ -1141,8 +1135,8 @@ file) (values)) -;;; Dump the code, constants, etc. for component. We pass in the assembler -;;; fixups, code vector and node info. +;;; Dump the code, constants, etc. for component. We pass in the +;;; assembler fixups, code vector and node info. (defun fasl-dump-component (component code-segment code-length @@ -1174,9 +1168,10 @@ (setf (gethash entry (fasl-file-entry-table file)) entry-handle) (let ((old (gethash entry (fasl-file-patch-table file)))) - ;; KLUDGE: All this code is shared with FASL-DUMP-BYTE-COMPONENT, - ;; and should probably be gathered up into a named function - ;; (DUMP-PATCHES?) called from both functions. + ;; FIXME: All this code is shared with + ;; FASL-DUMP-BYTE-COMPONENT, and should probably be gathered + ;; up into a named function (DUMP-PATCHES?) called from both + ;; functions. (when old (dolist (patch old) (dump-alter-code-object (car patch) @@ -1203,8 +1198,8 @@ (dump-push info-handle file) (push info-handle (fasl-file-debug-info file)))) - ;; The "trace table" is initialized by loader to hold a list of all byte - ;; functions in this code object (for debug info.) + ;; The "trace table" is initialized by loader to hold a list of + ;; all byte functions in this code object (for debug info.) (dump-object nil file) ;; Dump the constants. @@ -1270,8 +1265,8 @@ code-handle))) ;;; Dump a BYTE-FUNCTION object. We dump the layout and -;;; funcallable-instance info, but rely on the loader setting up the correct -;;; funcallable-instance-function. +;;; funcallable-instance info, but rely on the loader setting up the +;;; correct funcallable-instance-function. (defun dump-byte-function (xep code-handle file) (let ((nslots (- (get-closure-length xep) ;; 1- for header @@ -1313,19 +1308,21 @@ (remhash info patch-table)))))) (values)) -;;; Dump a FOP-FUNCALL to call an already dumped top-level lambda at load time. +;;; Dump a FOP-FUNCALL to call an already dumped top-level lambda at +;;; load time. (defun fasl-dump-top-level-lambda-call (fun file) (declare (type clambda fun) (type fasl-file file)) (let ((handle (gethash (leaf-info fun) (fasl-file-entry-table file)))) - (assert handle) + (aver handle) (dump-push handle file) (dump-fop 'sb!impl::fop-funcall-for-effect file) (dump-byte 0 file)) (values)) -;;; Compute the correct list of DEBUG-SOURCE structures and backpatch all of -;;; the dumped DEBUG-INFO structures. We clear the FASL-FILE-DEBUG-INFO, -;;; so that subsequent components with different source info may be dumped. +;;; Compute the correct list of DEBUG-SOURCE structures and backpatch +;;; all of the dumped DEBUG-INFO structures. We clear the +;;; FASL-FILE-DEBUG-INFO, so that subsequent components with different +;;; source info may be dumped. (defun fasl-dump-source-info (info file) (declare (type source-info info) (type fasl-file file)) (let ((res (debug-source-for-info info)) @@ -1344,8 +1341,6 @@ ;;;; dumping structures (defun dump-structure (struct file) - ;; FIXME: Probably *DUMP-ONLY-VALID-STRUCTURES* should become constantly T, - ;; right? (when *dump-only-valid-structures* (unless (gethash struct (fasl-file-valid-structures file)) (error "attempt to dump invalid structure:~% ~S~%How did this happen?"