From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 19 Sep 1990 00:32:55 +0000 (+0000)
Subject: Alter `unparser/tagged-pair-method' and
X-Git-Tag: 20090517-FFI~11179
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4b139b6b3a53cd4478997c49bfc74c85f114c749;p=mit-scheme.git

Alter `unparser/tagged-pair-method' and
`unparser/tagged-vector-method' to disallow futures as tags.
---

diff --git a/v7/src/runtime/boot.scm b/v7/src/runtime/boot.scm
index 5f1eee81f..8cac467a2 100644
--- a/v7/src/runtime/boot.scm
+++ b/v7/src/runtime/boot.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/boot.scm,v 14.3 1989/08/09 11:08:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/boot.scm,v 14.4 1990/09/19 00:32:41 cph Rel $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -92,4 +92,7 @@ MIT in each case. |#
 (define-primitives
   (object-pure? pure?)
   (object-constant? constant?)
-  get-next-constant)
\ No newline at end of file
+  get-next-constant)
+
+(define-integrable (future? object)
+  ((ucode-primitive object-type? 2) (ucode-type future) object))
\ No newline at end of file
diff --git a/v7/src/runtime/gdatab.scm b/v7/src/runtime/gdatab.scm
index d3df67da7..05605d438 100644
--- a/v7/src/runtime/gdatab.scm
+++ b/v7/src/runtime/gdatab.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gdatab.scm,v 14.4 1989/06/09 16:51:21 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gdatab.scm,v 14.5 1990/09/19 00:32:28 cph Rel $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -53,13 +53,15 @@ MIT in each case. |#
 (define named-structure-descriptions)
 
 (define (unparser/tagged-pair-method tag)
-  (1d-table/get tagged-pair-methods tag false))
+  (and (not (future? tag))
+       (1d-table/get tagged-pair-methods tag false)))
 
 (define (unparser/set-tagged-pair-method! tag method)
   (1d-table/put! tagged-pair-methods tag method))
 
 (define (unparser/tagged-vector-method tag)
-  (1d-table/get tagged-vector-methods tag false))
+  (and (not (future? tag))
+       (1d-table/get tagged-vector-methods tag false)))
 
 (define (unparser/set-tagged-vector-method! tag method)
   (1d-table/put! tagged-vector-methods tag method))
diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm
index 188860082..481848d69 100644
--- a/v7/src/runtime/global.scm
+++ b/v7/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.17 1990/09/11 21:58:52 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.18 1990/09/19 00:32:55 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -167,9 +167,6 @@ MIT in each case. |#
       (if (< (real-time-clock) end)
 	  (wait-loop)))))
 
-(define-integrable (future? object)
-  ((ucode-primitive object-type? 2) (ucode-type future) object))
-
 (define (exit)
   (if (prompt-for-confirmation "Kill Scheme")
       (%exit)))
diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm
index 58d36b258..b064b0c77 100644
--- a/v8/src/runtime/global.scm
+++ b/v8/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.17 1990/09/11 21:58:52 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.18 1990/09/19 00:32:55 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -167,9 +167,6 @@ MIT in each case. |#
       (if (< (real-time-clock) end)
 	  (wait-loop)))))
 
-(define-integrable (future? object)
-  ((ucode-primitive object-type? 2) (ucode-type future) object))
-
 (define (exit)
   (if (prompt-for-confirmation "Kill Scheme")
       (%exit)))