0.6.12.3:
[sbcl.git] / src / compiler / dump.lisp
index e883864..d17167c 100644 (file)
 ;;; 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
+;;; 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*))
 (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))
 
 ;;; 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)
 \f
 ;;;; 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,
              ;; 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))
 (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))
 \f
 ;;;; 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)
 ;;; 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)))
               ;; 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
       ;; 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)))
 (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))