0.6.8.6: applied MNA megapatch (will be edited shortly)
[sbcl.git] / src / compiler / dump.lisp
index 5a3b26f..a8acaee 100644 (file)
   (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
           (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))