Remove the concept of safe primitives since the microcode now takes

care of them.

Add primitive uuo link unparsing to the disassembler.

diff --git a/v7/src/compiler/base/utils.scm b/v7/src/compiler/base/utils.scm
index 7ec9eec1206bd1922ad12e74782484870376cee9..fdf1004e47c3abea9d13f8f9c80e8847fe604168 100644 (file)
--- 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 4.11 1989/04/15 18:05:57 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/utils.scm,v 4.12 1989/05/31 20:01:36 jinx Rel $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -169,65 +169,19 @@ MIT in each case. |#
         type-code:extended-procedure)
        (else
         (error "SCODE/PROCEDURE-TYPE-CODE: Unknown lambda type" *lambda))))
-\f
-;;;; Primitive Procedures
+
+;;; Primitive Procedures
 
 (define (primitive-procedure? object)
   (or (eq? compiled-error-procedure object)
       (scode/primitive-procedure? object)))
 
-(define (normal-primitive-procedure? object)
-  (or (eq? compiled-error-procedure object)
-      (and (scode/primitive-procedure? object)
-          (primitive-procedure-safe? object))))
-
 (define (primitive-arity-correct? primitive argument-count)
   (if (eq? primitive compiled-error-procedure)
       (positive? argument-count)
       (let ((arity (primitive-procedure-arity primitive)))
        (or (= arity -1)
            (= arity argument-count)))))
-
-(define (primitive-procedure-safe? object)
-  (and (object-type? (ucode-type primitive) object)
-       (not (memq object unsafe-primitive-procedures))))
-
-(define unsafe-primitive-procedures
-  (let-syntax ((primitives
-               (macro names
-                 `'(,@(map (lambda (spec)
-                             (if (pair? spec)
-                                 (apply make-primitive-procedure spec)
-                                 (make-primitive-procedure spec)))
-                           names)))))
-    (primitives scode-eval
-               apply
-               force
-               error-procedure
-               within-control-point
-               call-with-current-continuation
-               non-reentrant-call-with-current-continuation
-               with-interrupt-mask
-               with-interrupts-reduced
-               execute-at-new-state-point
-               translate-to-state-point
-               set-current-history!
-               with-history-disabled
-               garbage-collect
-               primitive-purify
-               primitive-impurify
-               primitive-fasdump
-               dump-band
-               load-band
-               (primitive-eval-step 3)
-               (primitive-apply-step 3)
-               (primitive-return-step 2)
-               (dump-world 1)
-               (complete-garbage-collect 1)
-               (with-saved-fluid-bindings 1)
-               (global-interrupt 3)
-               (get-work 1)
-               (master-gc-loop 1))))
 \f
 ;;;; Special Compiler Support
 

diff --git a/v7/src/compiler/fgopt/order.scm b/v7/src/compiler/fgopt/order.scm
index 78dfd934bf847ee99df0bc86a5a0be025588d338..e9ea55903f425b15c3e683a6e3d2c15cebd2b195 100644 (file)
--- a/v7/src/compiler/fgopt/order.scm
+++ b/v7/src/compiler/fgopt/order.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/order.scm,v 4.11 1989/04/21 16:32:10 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/order.scm,v 4.12 1989/05/31 20:01:50 jinx Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -456,7 +456,7 @@ MIT in each case. |#
           (or (not (reference? operator))
               (reference-to-known-location? operator)))
          ((rvalue/constant? callee)
-          (not (normal-primitive-procedure? (constant-value callee))))
+          (not (primitive-procedure? (constant-value callee))))
          ((rvalue/procedure? callee)
           (case (procedure/type callee)
             ((OPEN-EXTERNAL OPEN-INTERNAL) false)

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index e8bb992a2f4d0c52f7831bcf765f26451ff28a80..59b072ce35acf3ae2e6a946e82747e007ee6ca3d 100644 (file)
--- a/v7/src/compiler/machines/bobcat/make.scm-68040
+++ b/v7/src/compiler/machines/bobcat/make.scm-68040
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.44 1989/05/21 14:52:30 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.45 1989/05/31 20:01:20 jinx Rel $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -41,4 +41,4 @@ MIT in each case. |#
            ((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
          '((COMPILER MACROS)
            (COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (Motorola MC68020)" 4 44 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (Motorola MC68020)" 4 45 '()))
\ No newline at end of file

diff --git a/v7/src/compiler/rtlgen/rgcomb.scm b/v7/src/compiler/rtlgen/rgcomb.scm
index 45ebb48dc92cd2601053719f7d5230afb7479de1..f3362f999651afaef811820d75f0790fd1b20432 100644 (file)
--- a/v7/src/compiler/rtlgen/rgcomb.scm
+++ b/v7/src/compiler/rtlgen/rgcomb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgcomb.scm,v 4.9 1988/12/12 21:52:32 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgcomb.scm,v 4.10 1989/05/31 20:02:11 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
                    invocation/reference
                    invocation/apply))
               ((rvalue/constant? model)
-               (if (normal-primitive-procedure? (constant-value model))
+               (if (primitive-procedure? (constant-value model))
                    invocation/primitive
                    invocation/apply))
               ((rvalue/procedure? model)

diff --git a/v7/src/compiler/rtlgen/rtlgen.scm b/v7/src/compiler/rtlgen/rtlgen.scm
index 0728040db4345deba2bdc35967b691b8d41c6c3e..9a2d527776b84afc49dca7606164c0872d20cfb4 100644 (file)
--- a/v7/src/compiler/rtlgen/rtlgen.scm
+++ b/v7/src/compiler/rtlgen/rtlgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rtlgen.scm,v 4.17 1989/04/15 18:04:34 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rtlgen.scm,v 4.18 1989/05/31 20:02:25 jinx Rel $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -169,7 +169,7 @@ MIT in each case. |#
 (define (operator/needs-no-heap-check? op)
   (and (rvalue/constant? op)
        (let ((obj (constant-value op)))
-        (and (normal-primitive-procedure? obj)
+        (and (primitive-procedure? obj)
              (special-primitive-handler obj)))))
 \f
 (define (wrap-with-continuation-entry context scfg)