X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fdump.lisp;h=a8acaeea781ec012c7b68730e6b2efba7dd0d520;hb=5eb97830eca716fef626c6e12429c99c9b97e3c8;hp=909412b62e62ca9d655b6e8d144c3a1df14e1469;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 909412b..a8acaee 100644
--- 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))
 
+
+;;; 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)