From 0179abfbb7ef52400365d3cba4aa77a2faf25d3c Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Thu, 22 Jun 1995 15:18:44 +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. Added code to attach declarartions IGNORE-REFERENCE-TRAPS and IGNORE-ASSIGNMENT-TRAPS to the environment frame for the block in which they occur. TO DO: (1) include reference environment in captures (2) use this to determine whether or not the reference has an IGNORE-* declaration and fill in the %variable-cache-ref (etc) slots. --- v8/src/compiler/midend/envconv.scm | 40 ++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 7 deletions(-) diff --git a/v8/src/compiler/midend/envconv.scm b/v8/src/compiler/midend/envconv.scm index 55ede7f17..56831a7ff 100644 --- a/v8/src/compiler/midend/envconv.scm +++ b/v8/src/compiler/midend/envconv.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: envconv.scm,v 1.9 1995/05/11 16:13:54 adams Exp $ +$Id: envconv.scm,v 1.10 1995/06/22 15:18:44 adams Exp $ Copyright (c) 1994-1995 Massachusetts Institute of Technology @@ -47,7 +47,7 @@ MIT in each case. |# ;; of from the referencing frame. ;; 2. ;; (CALL (QUOTE ,%variable-cache-ref) (QUOTE #F) -;; (LOOKUP ) (QUOTE )) +;; (LOOKUP ) (QUOTE #F/#T) (QUOTE )) ;; where is a new variable bound to ;; (CALL (QUOTE ,%make-read-variable-cache) (QUOTE #F) ;; (LOOKUP ,env-variable) (QUOTE )) @@ -75,12 +75,17 @@ MIT in each case. |# (define *envconv/copying?*) (define *envconv/separate-queue*) (define *envconv/top-level-program*) +(define *envconv/top-level-declarations* #F) (define *envconv/debug/walking-queue* #F) + (define (envconv/top-level program) (fluid-let ((*envconv/copying?* false) (*envconv/separate-queue* '()) - (*envconv/top-level-program* program)) + (*envconv/top-level-program* program) + (*envconv/top-level-declarations* + (or *envconv/top-level-declarations* ;recursive or first time? + (list 'DECLARE)))) (let ((result (envconv/trunk 'TOP-LEVEL program (lambda (copy? program*) copy? ; ignored @@ -287,8 +292,18 @@ MIT in each case. |# `(QUOTE ,object)) (define-environment-converter DECLARE (env #!rest anything) - env ; ignored - `(DECLARE ,@anything)) + (define interesting-declarations + '(IGNORE-REFERENCE-TRAPS IGNORE-ASSIGNMENT-TRAPS)) + (define (interesting-declaration? text) + (and (pair? text) + (memq (car text) interesting-declarations))) + (call-with-values + (lambda () + (list-split anything interesting-declaration?)) + (lambda (interesting other) + (set-cdr! (envconv/env/declarations env) + (append interesting (cdr (envconv/env/declarations env)))) + `(DECLARE ,@other)))) ;;;; Dispatcher @@ -320,6 +335,9 @@ MIT in each case. |# (define (envconv/expr env expr) (envconv/expr-with-name env expr #f)) +(define (envconv/expr/top-level env expr) + (envconv/expr env expr)) + (define (envconv/expr* env exprs) (map (lambda (expr) (envconv/expr env expr)) @@ -382,7 +400,11 @@ MIT in each case. |# (wrapper false read-only false) (body false read-only false) (result false read-only false) - (block false read-only false)) + (block false read-only false) + (declarations (if (eq? context 'TOP-LEVEL) + *envconv/top-level-declarations* + (list 'DECLARE)) + read-only true)) (define-structure (envconv/binding @@ -491,7 +513,7 @@ MIT in each case. |# (let* ((copying* (or (eq? context 'ARBITRARY) *envconv/copying?*)) (env (envconv/env/make 'TOP-LEVEL #f)) (result (fluid-let ((*envconv/copying?* copying*)) - (envconv/expr env program))) + (envconv/expr/top-level env program))) (needs? (or (envconv/env/reified? env) (not (null? (envconv/env/bindings env))))) (program* @@ -772,6 +794,7 @@ MIT in each case. |# `(CALL (QUOTE ,%variable-cache-ref) (QUOTE #F) (LOOKUP ,cell-name) + (QUOTE #F) (QUOTE ,var-name)))) ((SET!) (let ((write-cell-name @@ -785,12 +808,14 @@ MIT in each case. |# `(CALL (QUOTE ,%safe-variable-cache-ref) (QUOTE #F) (LOOKUP ,read-cell-name) + (QUOTE #F) ;ignore-traps? (QUOTE ,var-name)) `(BEGIN (CALL (QUOTE ,%variable-cache-set!) (QUOTE #F) (LOOKUP ,write-cell-name) ,(set!/expr reference) + (QUOTE ,#F) ;ignore traps? (QUOTE ,var-name)) (LOOKUP ,temp-name))))) ((UNASSIGNED?) @@ -801,6 +826,7 @@ MIT in each case. |# (CALL (QUOTE ,%safe-variable-cache-ref) (QUOTE #F) (LOOKUP ,cell-name) + (QUOTE #F) ;ignore-traps? (QUOTE ,var-name))))) ((CALL) -- 2.25.1