From 7ad40b684fe2482d25d972f616a5cc57b1b1d7dd Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Thu, 22 Jun 1995 15:11:12 +0000 Subject: [PATCH] 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. --- v8/src/compiler/midend/compat.scm | 43 ++++++++++++----------------- v8/src/compiler/midend/fakeprim.scm | 18 ++++++------ v8/src/compiler/midend/triveval.scm | 16 +++++------ 3 files changed, 36 insertions(+), 41 deletions(-) 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 'NAME) - ;; ------- rator ------- cont -------- rands ----------- + ;; (CALL %variable-cache-ref '#F '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 'NAME) + ;; (CALL ',%safe-variable-cache-ref '#F + ;; '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 'NAME) - ;; -------- rator -------- cont -------- rands ----------- + ;; (CALL ',%variable-cache-set! '#F '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 'NAME) + ;; (CALL %variable-cache-ref '#F '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 - ;; 'NAME) + ;; '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 'NAME) + ;; (CALL ',%safe-variable-cache-ref '#F + ;; '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 '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)) -- 2.25.1