From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 17 Apr 1987 07:38:02 +0000 (+0000)
Subject: External primitives are not safe.
X-Git-Tag: 20090517-FFI~13618
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a3c510d8d82f67869f6a310a78570f2ce4d1d23d;p=mit-scheme.git

External primitives are not safe.
---

diff --git a/v7/src/compiler/base/utils.scm b/v7/src/compiler/base/utils.scm
index 6353b42ef..da2f59721 100644
--- a/v7/src/compiler/base/utils.scm
+++ b/v7/src/compiler/base/utils.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 1.84 1987/04/13 23:59:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 1.85 1987/04/17 07:38:02 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -221,33 +221,34 @@ MIT in each case. |#
 ;;; Disgusting hack to replace microcode implementation.
 
 (define (primitive-procedure-safe? object)
-  (not (memq object
-	     (let-syntax ((primitives
-			   (macro names
-			     `'(,@(map make-primitive-procedure names)))))
-	       (primitives call-with-current-continuation
-			   non-reentrant-call-with-current-continuation
-			   scode-eval
-			   apply
-			   garbage-collect
-			   primitive-fasdump
-			   set-current-history!
-			   with-history-disabled
-			   force
-			   primitive-purify
-			   complete-garbage-collect
-			   dump-band
-			   primitive-impurify
-			   with-threaded-continuation
-			   within-control-point
-			   with-interrupts-reduced
-			   primitive-eval-step
-			   primitive-apply-step
-			   primitive-return-step
-			   execute-at-new-state-point
-			   translate-to-state-point
-			   with-interrupt-mask
-			   error-procedure)))))
+  (and (primitive-type? (ucode-type primitive) object)
+       (not (memq object
+		  (let-syntax ((primitives
+				(macro names
+				  `'(,@(map make-primitive-procedure names)))))
+		    (primitives call-with-current-continuation
+				non-reentrant-call-with-current-continuation
+				scode-eval
+				apply
+				garbage-collect
+				primitive-fasdump
+				set-current-history!
+				with-history-disabled
+				force
+				primitive-purify
+				complete-garbage-collect
+				dump-band
+				primitive-impurify
+				with-threaded-continuation
+				within-control-point
+				with-interrupts-reduced
+				primitive-eval-step
+				primitive-apply-step
+				primitive-return-step
+				execute-at-new-state-point
+				translate-to-state-point
+				with-interrupt-mask
+				error-procedure))))))
 
 ;;;; Special Compiler Support
 
@@ -263,6 +264,7 @@ MIT in each case. |#
       (primitive-type? (ucode-type fixnum) object)
       (primitive-type? (ucode-type character) object)
       (primitive-type? (ucode-type unassigned) object)
+      (primitive-type? (ucode-type primitive) object)
       (primitive-type? (ucode-type the-environment) object)
       (primitive-type? (ucode-type manifest-nm-vector) object)
       (primitive-type? (ucode-type manifest-special-nm-vector) object)))