From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Thu, 22 Jun 1995 15:11:12 +0000 (+0000)
Subject: Extended %variable-cache-ref, %safe-variable-cacahe-ref and
X-Git-Tag: 20090517-FFI~6248
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7ad40b684fe2482d25d972f616a5cc57b1b1d7dd;p=mit-scheme.git
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 5a865c582..acb8f54f5 100644
--- 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. |#
(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)
;; 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 f0ccc1b06..152ac72f3 100644
--- 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)
(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 7fbe0fd22..bc6913048 100644
--- 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)))))))
(define *operator->procedure*
- (make-eq-hash-table 311))
+ (make-eq-hash-table))
(define (operator->procedure rator)
(if (not (symbol? rator))