From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 15 Jun 1987 23:42:12 +0000 (+0000)
Subject: Correctly fix unparser to detect unparsing of partially marked
X-Git-Tag: 20090517-FFI~13368
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e3384445879be128858f85e966b9ecda882bc969;p=mit-scheme.git

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 7b0dc0138..61c675428 100644
--- 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* '())