0.6.8.6: applied MNA megapatch (will be edited shortly)

[sbcl.git] / src / compiler / dump.lisp

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 909412b..a8acaee 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -11,9 +11,6 @@
 
 (in-package "SB!C")
 
-(file-comment
-  "$Header$")
-
 ;;; FIXME: Double colons are bad, and there are lots of them in this
 ;;; file, because both dump logic in SB!C and load logic in SB!IMPL
 ;;; need to know about fops. Perhaps all the load/dump logic should be
@@ -306,6 +303,16 @@
   (close (fasl-file-stream file) :abort abort-p)
   (values))
 \f
+
+;;; MNA dump-circular hack
+(defun circular-list-p (list)
+  (and (listp list)
+       (multiple-value-bind (res condition)
+           (ignore-errors (list-length list))
+         (if condition
+           nil
+           (null res)))))
+
 ;;;; main entries to object dumping
 
 ;;; This function deals with dumping objects that are complex enough so that
@@ -323,9 +330,14 @@
           (typecase x
             (symbol (dump-symbol x file))
             (list
+               ;; MNA dump-circular hack
+               (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)))
+                   (equal-save-object x file))))
             (layout
              (dump-layout x file)
              (eq-save-object x file))
@@ -336,7 +348,7 @@
              ;; FIXME: The comment at the head of DUMP-NON-IMMEDIATE-OBJECT
              ;; says it's for objects which we want to save, instead of
              ;; repeatedly dumping them. But then we dump arrays here without
-             ;; doing anything a la EQUAL-SAVE-OBJECT. What gives?
+             ;; doing anything like EQUAL-SAVE-OBJECT. What gives?
              (dump-array x file))
             (number
              (unless (equal-check-table x file)