Extended %variable-cache-ref, %safe-variable-cacahe-ref and

%variable-cache-set with an additional 'IGNORE-TRAPS? field.  This
field is always a quotes constant.  When True it causes reference or
assignment traps to be ignored.

diff --git a/v8/src/compiler/midend/compat.scm b/v8/src/compiler/midend/compat.scm
index 5a865c5823890f47aa360c735da4268f8b5887fc..acb8f54f5f7488c97b061862579439ebc70eb53e 100644 (file)
--- a/v8/src/compiler/midend/compat.scm
+++ b/v8/src/compiler/midend/compat.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: compat.scm,v 1.8 1995/03/11 17:44:22 adams Exp $
+$Id: compat.scm,v 1.9 1995/06/22 15:11:12 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -427,13 +427,14 @@ MIT in each case. |#
               . ,(compat/expr* env (cdr rands)))))))
 
 (define-rewrite/compat %variable-cache-ref
-  ;; (CALL ',%variable-cache-ref '#F <read-variable-cache> 'NAME)
-  ;;       ------- rator ------- cont -------- rands -----------
+  ;; (CALL %variable-cache-ref '#F <read-variable-cache> 'IGNORE-TRAPS? 'NAME)
+  ;;       ------ rator ------ cont -------- rands -----------
   (lambda (env rator cont rands)
     rator                              ; ignored
     (let ((cont  (compat/expr env cont))
          (cell  (compat/expr env (first rands)))
-         (quoted-name (compat/expr env (second rands))))
+         (ignore-traps? (compat/expr env (second rands)))
+         (quoted-name (compat/expr env (third rands))))
       (compat/verify-hook-continuation cont)
       (compat/verify-cache cell quoted-name)
       (let* ((%continue
@@ -447,7 +448,7 @@ MIT in each case. |#
             (cell-name
              (new-variable-cache-variable name `(VARIABLE-CACHE ,name)))
             (value-name (compat/new-name name)))
-       (if (compat/ignore-reference-traps? name)
+       (if (quote/text ignore-traps?)
            (%continue `(CALL (QUOTE ,%variable-cell-ref)
                              (QUOTE #F)
                              (CALL (QUOTE ,%variable-read-cache) (QUOTE #F)
@@ -468,12 +469,14 @@ MIT in each case. |#
 \f
 (define-rewrite/compat %safe-variable-cache-ref
   (lambda (env rator cont rands)
-    ;; (CALL ',%safe-variable-cache-ref '#F <read-variable-cache> 'NAME)
+    ;; (CALL ',%safe-variable-cache-ref '#F <read-variable-cache>
+    ;;       'IGNORE-TRAPS? 'NAME)
     ;;       --------- rator --------- cont -------- rands -----------
     rator                              ; ignored
     (let ((cont  (compat/expr env cont))
          (cell  (compat/expr env (first rands)))
-         (quoted-name (compat/expr env (second rands))))
+         (ignore-traps? (compat/expr env (second rands)))
+         (quoted-name (compat/expr env (third rands))))
       (compat/verify-hook-continuation cont)
       (compat/verify-cache cell quoted-name)
       (let* ((%continue
@@ -493,7 +496,7 @@ MIT in each case. |#
           (LET ((,value-name (CALL (QUOTE ,%variable-cell-ref)
                                    (QUOTE #F)
                                    (LOOKUP ,cell-name))))
-            ,(if (compat/ignore-reference-traps? name)
+            ,(if (quote/text ignore-traps?)
                  (%continue `(LOOKUP ,value-name))
                  `(IF (IF (CALL (QUOTE ,%reference-trap?)
                                 (QUOTE #F)
@@ -506,17 +509,6 @@ MIT in each case. |#
                       (CALL (QUOTE ,%hook-safe-variable-cell-ref)
                             ,cont
                             (LOOKUP ,cell-name))))))))))
-
-
-;;;  These predicates should determine the right answers from declarations:
-
-(define (compat/ignore-reference-traps? name)
-  name
-  #F)
-
-(define (compat/ignore-assignment-traps? name)
-  name
-  #F)
 \f
 ;; NOTE: This is never in value position because envconv expands
 ;; all cell sets into begins.  In particular, this means that cont
@@ -527,13 +519,14 @@ MIT in each case. |#
 
 (define-rewrite/compat %variable-cache-set!
   (lambda (env rator cont rands)
-    ;; (CALL ',%variable-write-cache '#F <write-variable-cache> 'NAME)
-    ;;       -------- rator -------- cont -------- rands -----------
+    ;; (CALL ',%variable-cache-set! '#F <write-variable-cache> 'IGNORE-TRAPS? 'NAME)
+    ;;       ------- rator -------- cont -------- rands -----------
     rator                              ; ignored
-    (let ((cont        (compat/expr env cont))
-         (cell        (compat/expr env (first rands)))
-         (value       (compat/expr env (second rands)))
-         (quoted-name (compat/expr env (third rands))))
+    (let ((cont          (compat/expr env cont))
+         (cell          (compat/expr env (first rands)))
+         (value         (compat/expr env (second rands)))
+         (ignore-traps? (compat/expr env (third rands)))
+         (quoted-name   (compat/expr env (fourth rands))))
       ;; (compat/verify-hook-continuation cont)
       (if (not (equal? cont '(QUOTE #F)))
          (internal-error "Unexpected continuation to variable cache assignment"

diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index f0ccc1b0635e39ea4cfac21f2dc696d9db4c774a..152ac72f30ec436a0eeb549c39bda595327d506a 100644 (file)
--- a/v8/src/compiler/midend/fakeprim.scm
+++ b/v8/src/compiler/midend/fakeprim.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fakeprim.scm,v 1.16 1995/06/22 01:50:10 adams Exp $
+$Id: fakeprim.scm,v 1.17 1995/06/22 15:09:29 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -308,7 +308,7 @@ MIT in each case. |#
             'descriptor operator-cache #!rest values)
 
 (define %variable-cache-ref
-  ;; (CALL ',%variable-cache-ref '#F <read-variable-cache> 'NAME)
+  ;; (CALL %variable-cache-ref '#F <read-variable-cache> 'ignore-traps? 'NAME)
   ;; Note:
   ;;   Introduced by envconv.scm, removed by compat.scm (replaced by a
   ;;     lot of hairy code)
@@ -317,21 +317,23 @@ MIT in each case. |#
   (make-operator "#[variable-cache-ref]"
                 '(SIDE-EFFECT-FREE) '(OUT-OF-LINE-HOOK)))
 
-(cookie-call %variable-cache-ref '#F read-variable-cache 'NAME)
+(cookie-call %variable-cache-ref '#F read-variable-cache 'IGNORE-TRAPS? 'NAME)
 
 (define %variable-cache-set!
   ;; (CALL ',%variable-cache-set! '#F <write-variable-cache>
-  ;;       <value> 'NAME)
+  ;;       <value> 'IGNORE-TRAPS? 'NAME)
   ;; Note:
   ;;   Introduced by envconv.scm, removed by compat.scm (replaced by a
   ;;     lot of hairy code)
   ;;   The NAME is redundant with the code that creates the variable cache
   (make-operator "#[variable-cache-set!]" '(OUT-OF-LINE-HOOK)))
 
-(cookie-call %variable-cache-set! '#F write-variable-cache value 'NAME)
+(cookie-call %variable-cache-set! '#F write-variable-cache value
+            'IGNORE-TRAPS? 'NAME)
 
 (define %safe-variable-cache-ref
-  ;; (CALL ',%safe-variable-cache-ref '#F <read-variable-cache> 'NAME)
+  ;; (CALL ',%safe-variable-cache-ref '#F <read-variable-cache>
+  ;;       'IGNORE-TRAPS? 'NAME)
   ;; Note:
   ;;   Introduced by envconv.scm, removed by compat.scm (replaced by a
   ;;     lot of hairy code)
@@ -341,8 +343,8 @@ MIT in each case. |#
   (make-operator "#[safe-variable-cache-ref]"
                 '(SIDE-EFFECT-FREE) '(OUT-OF-LINE-HOOK)))
 
-
-(cookie-call %safe-variable-cache-ref '#F read-variable-cache 'NAME)
+(cookie-call %safe-variable-cache-ref '#F read-variable-cache
+            'IGNORE-TRAPS? 'NAME)
 \f
 (define %variable-read-cache
   ;; (CALL ',%variable-read-cache '#F <read-variable-cache> 'NAME)

diff --git a/v8/src/compiler/midend/triveval.scm b/v8/src/compiler/midend/triveval.scm
index 7fbe0fd22fa79fd6ce1da7473673e3d52cb891c6..bc69130483e19d14e01f6328a9e1f8cfae9967a6 100644 (file)
--- a/v8/src/compiler/midend/triveval.scm
+++ b/v8/src/compiler/midend/triveval.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: triveval.scm,v 1.4 1995/03/20 02:01:28 adams Exp $
+$Id: triveval.scm,v 1.5 1995/06/22 15:09:07 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -232,19 +232,19 @@ MIT in each case. |#
 (define (make-write-variable-cache env name)
   (variable-cache/make env name))
 
-(define (variable-cache-ref cache name)
-  name                                 ; ignored
+(define (variable-cache-ref cache ignore-traps? name)
+  ignore-traps? name                   ; ignored
   (lexical-reference (variable-cache/env cache)
                     (variable-cache/name cache)))
 
-(define (variable-cache-set! cache value name)
-  name                                 ; ignored
+(define (variable-cache-set! cache value ignore-traps? name)
+  ignore-traps? name                   ; ignored
   (lexical-assignment (variable-cache/env cache)
                      (variable-cache/name cache)
                      value))
 
-(define (safe-variable-cache-ref cache name)
-  name                                 ; ignored
+(define (safe-variable-cache-ref cache ignore-traps? name)
+  ignore-traps? name                   ; ignored
   (let ((env (variable-cache/env cache))
        (name (variable-cache/name cache)))
     (if (lexical-unassigned? env name)
@@ -365,7 +365,7 @@ MIT in each case. |#
              (reverse (cdr elements)))))))
 \f
 (define *operator->procedure*
-  (make-eq-hash-table 311))
+  (make-eq-hash-table))
 
 (define (operator->procedure rator)
   (if (not (symbol? rator))