Correctly fix unparser to detect unparsing of partially marked

vectors.

diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index 7b0dc01388c1ae06219605e4b9fee3f09ea57cea..61c6754280c1dd50ccf35c64b62d252d2db9277f 100644 (file)
--- a/v7/src/runtime/unpars.scm
+++ b/v7/src/runtime/unpars.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 13.45 1987/06/15 18:22:43 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 13.46 1987/06/15 23:42:12 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -168,35 +168,34 @@
   (let ((nmv-type (microcode-type 'manifest-nm-vector))
        (snmv-type  (microcode-type 'manifest-special-nm-vector)))
     (lambda (vector)
-      (let ((length (vector-length vector)))
+      (let ((length (vector-length vector))
+           (element
+            (lambda (index)
+              (if (with-interrupt-mask interrupt-mask-none
+                    (lambda (ie)
+                      (or (primitive-type? nmv-type (vector-ref vector index))
+                          (primitive-type? snmv-type (vector-ref vector index)))))
+                  (error "Attempt to unparse partially marked vector" 0)
+                  (vector-ref vector index)))))
        (let ((normal
               (lambda ()
-                (*unparse-char #\#)
-                (let loop ((index 0))
-                  (cond ((= index length)
-                         (*unparse-char #\)))
-                        ((with-interrupt-mask interrupt-mask-none
-                           (lambda (ie)
-                             (or (primitive-type? nmv-type
-                                                  (vector-ref vector index))
-                                 (primitive-type?
-                                  snmv-type
-                                  (vector-ref vector index)))))
-                         (error "Attempt to unparse partially marked vector"))
+                (*unparse-string "#(")
+                (*unparse-object-or-future (element 0))
+                (let loop ((index 1))
+                  (cond ((= index length) (*unparse-char #\)))
                         (else
                          (*unparse-char #\Space)
-                         (*unparse-object-or-future (vector-ref vector index))
+                         (*unparse-object-or-future (element index))
                          (loop (1+ index))))))))
-       (cond ((zero? length)
-              (*unparse-string "#()"))
-             ((future? vector)
-              (normal))
-             (else
-              (let ((entry
-                     (assq (vector-ref vector 0) *unparser-special-objects*)))
-                (if entry
-                    ((cdr entry) vector)
-                    (normal)))))))))
+         (cond ((zero? length)
+                (*unparse-string "#()"))
+               ((future? vector)
+                (normal))
+               (else
+                (let ((entry (assq (element 0) *unparser-special-objects*)))
+                  (if entry
+                      ((cdr entry) vector)
+                      (normal))))))))))
 
 (define *unparser-special-objects* '())