From 8772c67a497bc2e817b51079d01143d8a382ab01 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Mon, 9 Nov 1992 18:50:24 +0000 Subject: [PATCH] Add label argument to all interpreter calls for the C back-end. --- v7/src/compiler/machines/alpha/rules4.scm | 82 ++++++++----- v7/src/compiler/machines/bobcat/rules4.scm | 104 ++++++++++------- v7/src/compiler/machines/i386/rules4.scm | 114 +++++++++++-------- v7/src/compiler/machines/mips/rules4.scm | 85 +++++++++----- v7/src/compiler/machines/spectrum/rules4.scm | 86 +++++++++----- v7/src/compiler/machines/vax/rules4.scm | 32 ++++-- v7/src/compiler/rtlbase/rtlcon.scm | 28 ++--- v7/src/compiler/rtlbase/rtlty1.scm | 105 ++++++++++------- v7/src/compiler/rtlgen/rgproc.scm | 18 +-- v7/src/compiler/rtlgen/rgrval.scm | 20 ++-- v7/src/compiler/rtlgen/rgstmt.scm | 43 ++++--- v7/src/compiler/rtlgen/rtlgen.scm | 12 +- 12 files changed, 449 insertions(+), 280 deletions(-) diff --git a/v7/src/compiler/machines/alpha/rules4.scm b/v7/src/compiler/machines/alpha/rules4.scm index d70e303e4..8ac7e7de4 100644 --- a/v7/src/compiler/machines/alpha/rules4.scm +++ b/v7/src/compiler/machines/alpha/rules4.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rules4.scm,v 1.1 1992/08/29 13:51:32 jinx Exp $ +$Id: rules4.scm,v 1.2 1992/11/09 18:50:24 jinx Exp $ Copyright (c) 1992 Digital Equipment Corporation (D.E.C.) @@ -40,26 +40,69 @@ case. (declare (usual-integrations)) +;;;; Variable cache trap handling. + +(define-rule statement + (INTERPRETER-CALL:CACHE-REFERENCE (? cont) + (REGISTER (? extension)) + (? safe?)) + cont ; ignored + (LAP ,@(load-interface-args! false extension false false) + ,@(link-to-interface + (if safe? + code:compiler-safe-reference-trap + code:compiler-reference-trap)))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) + (REGISTER (? extension)) + (? value register-expression)) + cont ; ignored + (LAP ,@(load-interface-args! false extension value false) + ,@(link-to-interface code:compiler-assignment-trap))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) + (REGISTER (? extension))) + cont ; ignored + (LAP ,@(load-interface-args! false extension false false) + ,@(link-to-interface code:compiler-unassigned?-trap))) + ;;;; Interpreter Calls +;;; All the code that follows is obsolete. It hasn't been used in a while. +;;; It is provided in case the relevant switches are turned off, but there +;;; is no real reason to do this. Perhaps the switches should be removed. + (define-rule statement - (INTERPRETER-CALL:ACCESS (? environment register-expression) (? name)) + (INTERPRETER-CALL:ACCESS (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-access environment name)) (define-rule statement - (INTERPRETER-CALL:LOOKUP (? environment register-expression) + (INTERPRETER-CALL:LOOKUP (? cont) + (? environment register-expression) (? name) (? safe?)) + cont ; ignored (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) environment name)) (define-rule statement - (INTERPRETER-CALL:UNASSIGNED? (? environment register-expression) (? name)) + (INTERPRETER-CALL:UNASSIGNED? (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-unassigned? environment name)) (define-rule statement - (INTERPRETER-CALL:UNBOUND? (? environment register-expression) (? name)) + (INTERPRETER-CALL:UNBOUND? (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-unbound? environment name)) (define (lookup-call code environment name) @@ -68,37 +111,22 @@ case. ,@(link-to-interface code))) (define-rule statement - (INTERPRETER-CALL:DEFINE (? environment register-expression) + (INTERPRETER-CALL:DEFINE (? cont) + (? environment register-expression) (? name) (? value register-expression)) + cont ; ignored (assignment-call code:compiler-define environment name value)) (define-rule statement - (INTERPRETER-CALL:SET! (? environment register-expression) + (INTERPRETER-CALL:SET! (? cont) + (? environment register-expression) (? name) (? value register-expression)) + cont ; ignored (assignment-call code:compiler-set! environment name value)) (define (assignment-call code environment name value) (LAP ,@(load-interface-args! false environment false value) ,@(load-constant regnum:third-arg name #F #F) - ,@(link-to-interface code))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-REFERENCE (REGISTER (? extension)) (? safe?)) - (LAP ,@(load-interface-args! false extension false false) - ,@(link-to-interface - (if safe? - code:compiler-safe-reference-trap - code:compiler-reference-trap)))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-ASSIGNMENT (REGISTER (? extension)) - (? value register-expression)) - (LAP ,@(load-interface-args! false extension value false) - ,@(link-to-interface code:compiler-assignment-trap))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-UNASSIGNED? (REGISTER (? extension))) - (LAP ,@(load-interface-args! false extension false false) - ,@(link-to-interface code:compiler-unassigned?-trap))) \ No newline at end of file + ,@(link-to-interface code))) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/rules4.scm b/v7/src/compiler/machines/bobcat/rules4.scm index f54ec0cf2..79f3d8514 100644 --- a/v7/src/compiler/machines/bobcat/rules4.scm +++ b/v7/src/compiler/machines/bobcat/rules4.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules4.scm,v 4.12 1990/05/03 15:17:38 jinx Rel $ +$Id: rules4.scm,v 4.13 1992/11/09 18:46:07 jinx Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -33,11 +33,56 @@ promotional, or sales literature without prior written consent from MIT in each case. |# ;;;; LAP Generation Rules: Interpreter Calls +;;; package: (compiler lap-syntaxer) (declare (usual-integrations)) +;;;; Variable cache trap handling. + +(define-rule statement + (INTERPRETER-CALL:CACHE-REFERENCE (? cont) (? extension) (? safe?)) + (QUALIFIER (interpreter-call-argument? extension)) + cont ; ignored + (let ((set-extension + (interpreter-call-argument->machine-register! extension d2))) + (let ((clear-map (clear-map!))) + (LAP ,@set-extension + ,@clear-map + (JSR ,(if safe? + entry:compiler-safe-reference-trap + entry:compiler-reference-trap)))))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) (? extension) (? value)) + (QUALIFIER (and (interpreter-call-argument? extension) + (interpreter-call-argument? value))) + cont ; ignored + (let ((set-extension + (interpreter-call-argument->machine-register! extension d2))) + (let ((set-value (interpreter-call-argument->machine-register! value d3))) + (let ((clear-map (clear-map!))) + (LAP ,@set-extension + ,@set-value + ,@clear-map + (JSR ,entry:compiler-assignment-trap)))))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) (? extension)) + (QUALIFIER (interpreter-call-argument? extension)) + cont ; ignored + (let ((set-extension + (interpreter-call-argument->machine-register! extension d2))) + (let ((clear-map (clear-map!))) + (LAP ,@set-extension + ,@clear-map + ,@(invoke-interface-jsr code:compiler-unassigned?-trap))))) + ;;;; Interpreter Calls +;;; All the code that follows is obsolete. It hasn't been used in a while. +;;; It is provided in case the relevant switches are turned off, but there +;;; is no real reason to do this. Perhaps the switches should be removed. + (define (interpreter-call-argument? expression) (or (rtl:register? expression) (rtl:constant? expression) @@ -70,24 +115,28 @@ MIT in each case. |# (error "Unknown expression type" (car expression)))))) (define-rule statement - (INTERPRETER-CALL:ACCESS (? environment) (? name)) + (INTERPRETER-CALL:ACCESS (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-access environment name)) (define-rule statement - (INTERPRETER-CALL:LOOKUP (? environment) (? name) (? safe?)) + (INTERPRETER-CALL:LOOKUP (? cont) (? environment) (? name) (? safe?)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) environment name)) (define-rule statement - (INTERPRETER-CALL:UNASSIGNED? (? environment) (? name)) + (INTERPRETER-CALL:UNASSIGNED? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-unassigned? environment name)) (define-rule statement - (INTERPRETER-CALL:UNBOUND? (? environment) (? name)) + (INTERPRETER-CALL:UNBOUND? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-unbound? environment name)) (define (lookup-call code environment name) @@ -100,15 +149,17 @@ MIT in each case. |# ,@(invoke-interface-jsr code))))) (define-rule statement - (INTERPRETER-CALL:DEFINE (? environment) (? name) (? value)) + (INTERPRETER-CALL:DEFINE (? cont) (? environment) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) + cont ; ignored (assignment-call code:compiler-define environment name value)) (define-rule statement - (INTERPRETER-CALL:SET! (? environment) (? name) (? value)) + (INTERPRETER-CALL:SET! (? cont) (? environment) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) + cont ; ignored (assignment-call code:compiler-set! environment name value)) (define (assignment-call code environment name value) @@ -120,39 +171,4 @@ MIT in each case. |# ,@set-value ,@clear-map ,@(load-constant name (INST-EA (D 3))) - ,@(invoke-interface-jsr code)))))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-REFERENCE (? extension) (? safe?)) - (QUALIFIER (interpreter-call-argument? extension)) - (let ((set-extension - (interpreter-call-argument->machine-register! extension d2))) - (let ((clear-map (clear-map!))) - (LAP ,@set-extension - ,@clear-map - (JSR ,(if safe? - entry:compiler-safe-reference-trap - entry:compiler-reference-trap)))))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) (? value)) - (QUALIFIER (and (interpreter-call-argument? extension) - (interpreter-call-argument? value))) - (let ((set-extension - (interpreter-call-argument->machine-register! extension d2))) - (let ((set-value (interpreter-call-argument->machine-register! value d3))) - (let ((clear-map (clear-map!))) - (LAP ,@set-extension - ,@set-value - ,@clear-map - (JSR ,entry:compiler-assignment-trap)))))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-UNASSIGNED? (? extension)) - (QUALIFIER (interpreter-call-argument? extension)) - (let ((set-extension - (interpreter-call-argument->machine-register! extension d2))) - (let ((clear-map (clear-map!))) - (LAP ,@set-extension - ,@clear-map - ,@(invoke-interface-jsr code:compiler-unassigned?-trap))))) \ No newline at end of file + ,@(invoke-interface-jsr code)))))) \ No newline at end of file diff --git a/v7/src/compiler/machines/i386/rules4.scm b/v7/src/compiler/machines/i386/rules4.scm index 6c05810cf..9091e6e60 100644 --- a/v7/src/compiler/machines/i386/rules4.scm +++ b/v7/src/compiler/machines/i386/rules4.scm @@ -1,7 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules4.scm,v 1.6 1992/02/28 20:23:57 jinx Exp $ -$mc68020-Header: rules4.scm,v 4.12 90/05/03 15:17:38 GMT jinx Exp $ +$Id: rules4.scm,v 1.7 1992/11/09 18:47:02 jinx Exp $ Copyright (c) 1992 Massachusetts Institute of Technology @@ -38,27 +37,81 @@ MIT in each case. |# (declare (usual-integrations)) +;;;; Variable cache trap handling. + +(define-rule statement + (INTERPRETER-CALL:CACHE-REFERENCE (? cont) (? extension) (? safe?)) + (QUALIFIER (interpreter-call-argument? extension)) + cont ; ignored + (let ((set-extension + (interpreter-call-argument->machine-register! extension edx))) + (LAP ,@set-extension + ,@(clear-map!) + #| + ,@(invoke-interface/call + (if safe? + code:compiler-safe-reference-trap + code:compiler-reference-trap)) + |# + ,@(invoke-hook/call (if safe? + entry:compiler-safe-reference-trap + entry:compiler-reference-trap))))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) (? extension) (? value)) + (QUALIFIER (and (interpreter-call-argument? extension) + (interpreter-call-argument? value))) + cont ; ignored + (let* ((set-extension + (interpreter-call-argument->machine-register! extension edx)) + (set-value (interpreter-call-argument->machine-register! value ebx))) + (LAP ,@set-extension + ,@set-value + ,@(clear-map!) + #| + ,@(invoke-interface/call code:compiler-assignment-trap) + |# + ,@(invoke-hook/call entry:compiler-assignment-trap)))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) (? extension)) + (QUALIFIER (interpreter-call-argument? extension)) + cont ; ignored + (let ((set-extension + (interpreter-call-argument->machine-register! extension edx))) + (LAP ,@set-extension + ,@(clear-map!) + ,@(invoke-interface/call code:compiler-unassigned?-trap)))) + ;;;; Interpreter Calls +;;; All the code that follows is obsolete. It hasn't been used in a while. +;;; It is provided in case the relevant switches are turned off, but there +;;; is no real reason to do this. Perhaps the switches should be removed. + (define-rule statement - (INTERPRETER-CALL:ACCESS (? environment) (? name)) + (INTERPRETER-CALL:ACCESS (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-access environment name)) (define-rule statement - (INTERPRETER-CALL:LOOKUP (? environment) (? name) (? safe?)) + (INTERPRETER-CALL:LOOKUP (? cont) (? environment) (? name) (? safe?)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) environment name)) (define-rule statement - (INTERPRETER-CALL:UNASSIGNED? (? environment) (? name)) + (INTERPRETER-CALL:UNASSIGNED? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-unassigned? environment name)) (define-rule statement - (INTERPRETER-CALL:UNBOUND? (? environment) (? name)) + (INTERPRETER-CALL:UNBOUND? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-unbound? environment name)) (define (lookup-call code environment name) @@ -70,15 +123,17 @@ MIT in each case. |# ,@(invoke-interface/call code)))) (define-rule statement - (INTERPRETER-CALL:DEFINE (? environment) (? name) (? value)) + (INTERPRETER-CALL:DEFINE (? cont) (? environment) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) + cont ; ignored (assignment-call code:compiler-define environment name value)) (define-rule statement - (INTERPRETER-CALL:SET! (? environment) (? name) (? value)) + (INTERPRETER-CALL:SET! (? cont) (? environment) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) + cont ; ignored (assignment-call code:compiler-set! environment name value)) (define (assignment-call code environment name value) @@ -90,45 +145,4 @@ MIT in each case. |# ,@(clear-map!) (MOV W ,reg:utility-arg-4 (R ,eax)) ,@(load-constant (INST-EA (R ,ebx)) name) - ,@(invoke-interface/call code)))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-REFERENCE (? extension) (? safe?)) - (QUALIFIER (interpreter-call-argument? extension)) - (let ((set-extension - (interpreter-call-argument->machine-register! extension edx))) - (LAP ,@set-extension - ,@(clear-map!) - #| - ,@(invoke-interface/call - (if safe? - code:compiler-safe-reference-trap - code:compiler-reference-trap)) - |# - ,@(invoke-hook/call (if safe? - entry:compiler-safe-reference-trap - entry:compiler-reference-trap))))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) (? value)) - (QUALIFIER (and (interpreter-call-argument? extension) - (interpreter-call-argument? value))) - (let* ((set-extension - (interpreter-call-argument->machine-register! extension edx)) - (set-value (interpreter-call-argument->machine-register! value ebx))) - (LAP ,@set-extension - ,@set-value - ,@(clear-map!) - #| - ,@(invoke-interface/call code:compiler-assignment-trap) - |# - ,@(invoke-hook/call entry:compiler-assignment-trap)))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-UNASSIGNED? (? extension)) - (QUALIFIER (interpreter-call-argument? extension)) - (let ((set-extension - (interpreter-call-argument->machine-register! extension edx))) - (LAP ,@set-extension - ,@(clear-map!) - ,@(invoke-interface/call code:compiler-unassigned?-trap)))) \ No newline at end of file + ,@(invoke-interface/call code)))) \ No newline at end of file diff --git a/v7/src/compiler/machines/mips/rules4.scm b/v7/src/compiler/machines/mips/rules4.scm index 0407a5025..7e07af13b 100644 --- a/v7/src/compiler/machines/mips/rules4.scm +++ b/v7/src/compiler/machines/mips/rules4.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/mips/rules4.scm,v 1.2 1991/10/25 00:13:33 cph Exp $ +$Id: rules4.scm,v 1.3 1992/11/09 18:47:45 jinx Exp $ -Copyright (c) 1988-91 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -33,29 +33,73 @@ promotional, or sales literature without prior written consent from MIT in each case. |# ;;;; LAP Generation Rules: Interpreter Calls +;;; package: (compiler lap-syntaxer) (declare (usual-integrations)) +;;;; Variable cache trap handling. + +(define-rule statement + (INTERPRETER-CALL:CACHE-REFERENCE (? cont) + (REGISTER (? extension)) + (? safe?)) + cont ; ignored + (LAP ,@(load-interface-args! false extension false false) + ,@(link-to-interface + (if safe? + code:compiler-safe-reference-trap + code:compiler-reference-trap)))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) + (REGISTER (? extension)) + (? value register-expression)) + cont ; ignored + (LAP ,@(load-interface-args! false extension value false) + ,@(link-to-interface code:compiler-assignment-trap))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) + (REGISTER (? extension))) + cont ; ignored + (LAP ,@(load-interface-args! false extension false false) + ,@(link-to-interface code:compiler-unassigned?-trap))) + ;;;; Interpreter Calls +;;; All the code that follows is obsolete. It hasn't been used in a while. +;;; It is provided in case the relevant switches are turned off, but there +;;; is no real reason to do this. Perhaps the switches should be removed. + (define-rule statement - (INTERPRETER-CALL:ACCESS (? environment register-expression) (? name)) + (INTERPRETER-CALL:ACCESS (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-access environment name)) (define-rule statement - (INTERPRETER-CALL:LOOKUP (? environment register-expression) + (INTERPRETER-CALL:LOOKUP (? cont) + (? environment register-expression) (? name) (? safe?)) + cont ; ignored (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) environment name)) (define-rule statement - (INTERPRETER-CALL:UNASSIGNED? (? environment register-expression) (? name)) + (INTERPRETER-CALL:UNASSIGNED? (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-unassigned? environment name)) (define-rule statement - (INTERPRETER-CALL:UNBOUND? (? environment register-expression) (? name)) + (INTERPRETER-CALL:UNBOUND? (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-unbound? environment name)) (define (lookup-call code environment name) @@ -64,37 +108,22 @@ MIT in each case. |# ,@(link-to-interface code))) (define-rule statement - (INTERPRETER-CALL:DEFINE (? environment register-expression) + (INTERPRETER-CALL:DEFINE (? cont) + (? environment register-expression) (? name) (? value register-expression)) + cont ; ignored (assignment-call code:compiler-define environment name value)) (define-rule statement - (INTERPRETER-CALL:SET! (? environment register-expression) + (INTERPRETER-CALL:SET! (? cont) + (? environment register-expression) (? name) (? value register-expression)) + cont ; ignored (assignment-call code:compiler-set! environment name value)) (define (assignment-call code environment name value) (LAP ,@(load-interface-args! false environment false value) ,@(load-constant regnum:third-arg name #F #F) - ,@(link-to-interface code))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-REFERENCE (REGISTER (? extension)) (? safe?)) - (LAP ,@(load-interface-args! false extension false false) - ,@(link-to-interface - (if safe? - code:compiler-safe-reference-trap - code:compiler-reference-trap)))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-ASSIGNMENT (REGISTER (? extension)) - (? value register-expression)) - (LAP ,@(load-interface-args! false extension value false) - ,@(link-to-interface code:compiler-assignment-trap))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-UNASSIGNED? (REGISTER (? extension))) - (LAP ,@(load-interface-args! false extension false false) - ,@(link-to-interface code:compiler-unassigned?-trap))) \ No newline at end of file + ,@(link-to-interface code))) \ No newline at end of file diff --git a/v7/src/compiler/machines/spectrum/rules4.scm b/v7/src/compiler/machines/spectrum/rules4.scm index db92bfa88..27ddc4259 100644 --- a/v7/src/compiler/machines/spectrum/rules4.scm +++ b/v7/src/compiler/machines/spectrum/rules4.scm @@ -1,9 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/rules4.scm,v 4.11 1990/01/25 16:43:39 jinx Rel $ -$MC68020-Header: rules4.scm,v 4.11 90/01/20 07:26:13 GMT cph Exp $ +$Id: rules4.scm,v 4.12 1992/11/09 18:41:58 jinx Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -34,29 +33,73 @@ promotional, or sales literature without prior written consent from MIT in each case. |# ;;;; LAP Generation Rules: Interpreter Calls +;;; package: (compiler lap-syntaxer) (declare (usual-integrations)) +;;;; Variable cache trap handling. + +(define-rule statement + (INTERPRETER-CALL:CACHE-REFERENCE (? cont) + (REGISTER (? extension)) + (? safe?)) + cont ; ignored + (LAP ,@(load-interface-args! false extension false false) + ,@(invoke-interface-ble + (if safe? + code:compiler-safe-reference-trap + code:compiler-reference-trap)))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) + (REGISTER (? extension)) + (? value register-expression)) + cont ; ignored + (LAP ,@(load-interface-args! false extension value false) + ,@(invoke-interface-ble code:compiler-assignment-trap))) + +(define-rule statement + (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) + (REGISTER (? extension))) + cont ; ignored + (LAP ,@(load-interface-args! false extension false false) + ,@(invoke-interface-ble code:compiler-unassigned?-trap))) + ;;;; Interpreter Calls +;;; All the code that follows is obsolete. It hasn't been used in a while. +;;; It is provided in case the relevant switches are turned off, but there +;;; is no real reason to do this. Perhaps the switches should be removed. + (define-rule statement - (INTERPRETER-CALL:ACCESS (? environment register-expression) (? name)) + (INTERPRETER-CALL:ACCESS (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-access environment name)) (define-rule statement - (INTERPRETER-CALL:LOOKUP (? environment register-expression) + (INTERPRETER-CALL:LOOKUP (? cont) + (? environment register-expression) (? name) (? safe?)) + cont ; ignored (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) environment name)) (define-rule statement - (INTERPRETER-CALL:UNASSIGNED? (? environment register-expression) (? name)) + (INTERPRETER-CALL:UNASSIGNED? (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-unassigned? environment name)) (define-rule statement - (INTERPRETER-CALL:UNBOUND? (? environment register-expression) (? name)) + (INTERPRETER-CALL:UNBOUND? (? cont) + (? environment register-expression) + (? name)) + cont ; ignored (lookup-call code:compiler-unbound? environment name)) (define (lookup-call code environment name) @@ -65,37 +108,22 @@ MIT in each case. |# ,@(invoke-interface-ble code))) (define-rule statement - (INTERPRETER-CALL:DEFINE (? environment register-expression) + (INTERPRETER-CALL:DEFINE (? cont) + (? environment register-expression) (? name) (? value register-expression)) + cont ; ignored (assignment-call code:compiler-define environment name value)) (define-rule statement - (INTERPRETER-CALL:SET! (? environment register-expression) + (INTERPRETER-CALL:SET! (? cont) + (? environment register-expression) (? name) (? value register-expression)) + cont ; ignored (assignment-call code:compiler-set! environment name value)) (define (assignment-call code environment name value) (LAP ,@(load-interface-args! false environment false value) ,@(load-constant name regnum:third-arg) - ,@(invoke-interface-ble code))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-REFERENCE (REGISTER (? extension)) (? safe?)) - (LAP ,@(load-interface-args! false extension false false) - ,@(invoke-interface-ble - (if safe? - code:compiler-safe-reference-trap - code:compiler-reference-trap)))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-ASSIGNMENT (REGISTER (? extension)) - (? value register-expression)) - (LAP ,@(load-interface-args! false extension value false) - ,@(invoke-interface-ble code:compiler-assignment-trap))) - -(define-rule statement - (INTERPRETER-CALL:CACHE-UNASSIGNED? (REGISTER (? extension))) - (LAP ,@(load-interface-args! false extension false false) - ,@(invoke-interface-ble code:compiler-unassigned?-trap))) \ No newline at end of file + ,@(invoke-interface-ble code))) \ No newline at end of file diff --git a/v7/src/compiler/machines/vax/rules4.scm b/v7/src/compiler/machines/vax/rules4.scm index eac509f7e..facd93c9b 100644 --- a/v7/src/compiler/machines/vax/rules4.scm +++ b/v7/src/compiler/machines/vax/rules4.scm @@ -1,9 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/vax/rules4.scm,v 4.3 1991/02/15 00:42:38 jinx Exp $ -$MC68020-Header: rules4.scm,v 4.12 90/05/03 15:17:38 GMT jinx Exp $ +$Id: rules4.scm,v 4.4 1992/11/09 18:47:18 jinx Exp $ -Copyright (c) 1987, 1989, 1991 Massachusetts Institute of Technology +Copyright (c) 1987-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -41,8 +40,9 @@ MIT in each case. |# ;;;; Variable cache trap handling. (define-rule statement - (INTERPRETER-CALL:CACHE-REFERENCE (? extension) (? safe?)) + (INTERPRETER-CALL:CACHE-REFERENCE (? cont) (? extension) (? safe?)) (QUALIFIER (interpreter-call-argument? extension)) + cont ; ignored (let* ((set-extension (interpreter-call-argument->machine-register! extension r2)) (clear-map (clear-map!))) @@ -59,9 +59,10 @@ MIT in each case. |# code:compiler-reference-trap))))) (define-rule statement - (INTERPRETER-CALL:CACHE-ASSIGNMENT (? extension) (? value)) + (INTERPRETER-CALL:CACHE-ASSIGNMENT (? cont) (? extension) (? value)) (QUALIFIER (and (interpreter-call-argument? extension) (interpreter-call-argument? value))) + cont ; ignored (let* ((set-extension (interpreter-call-argument->machine-register! extension r2)) (set-value (interpreter-call-argument->machine-register! value r3)) @@ -76,8 +77,9 @@ MIT in each case. |# ,@(invoke-interface-jsb code:compiler-assignment-trap)))) (define-rule statement - (INTERPRETER-CALL:CACHE-UNASSIGNED? (? extension)) + (INTERPRETER-CALL:CACHE-UNASSIGNED? (? cont) (? extension)) (QUALIFIER (interpreter-call-argument? extension)) + cont ; ignored (let* ((set-extension (interpreter-call-argument->machine-register! extension r2)) (clear-map (clear-map!))) @@ -92,24 +94,28 @@ MIT in each case. |# ;;; is no real reason to do this. Perhaps the switches should be removed. (define-rule statement - (INTERPRETER-CALL:ACCESS (? environment) (? name)) + (INTERPRETER-CALL:ACCESS (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-access environment name)) (define-rule statement - (INTERPRETER-CALL:LOOKUP (? environment) (? name) (? safe?)) + (INTERPRETER-CALL:LOOKUP (? cont) (? environment) (? name) (? safe?)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call (if safe? code:compiler-safe-lookup code:compiler-lookup) environment name)) (define-rule statement - (INTERPRETER-CALL:UNASSIGNED? (? environment) (? name)) + (INTERPRETER-CALL:UNASSIGNED? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-unassigned? environment name)) (define-rule statement - (INTERPRETER-CALL:UNBOUND? (? environment) (? name)) + (INTERPRETER-CALL:UNBOUND? (? cont) (? environment) (? name)) (QUALIFIER (interpreter-call-argument? environment)) + cont ; ignored (lookup-call code:compiler-unbound? environment name)) (define (lookup-call code environment name) @@ -122,15 +128,17 @@ MIT in each case. |# ,@(invoke-interface-jsb code)))) (define-rule statement - (INTERPRETER-CALL:DEFINE (? environment) (? name) (? value)) + (INTERPRETER-CALL:DEFINE (? environment) (? cont) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) + cont ; ignored (assignment-call code:compiler-define environment name value)) (define-rule statement - (INTERPRETER-CALL:SET! (? environment) (? name) (? value)) + (INTERPRETER-CALL:SET! (? environment) (? cont) (? name) (? value)) (QUALIFIER (and (interpreter-call-argument? environment) (interpreter-call-argument? value))) + cont ; ignored (assignment-call code:compiler-set! environment name value)) (define (assignment-call code environment name value) diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm index ed3266b53..f306e9540 100644 --- a/v7/src/compiler/rtlbase/rtlcon.scm +++ b/v7/src/compiler/rtlbase/rtlcon.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 4.22 1991/10/25 00:14:14 cph Exp $ +$Id: rtlcon.scm,v 4.23 1992/11/09 18:42:25 jinx Exp $ -Copyright (c) 1988-91 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -166,10 +166,10 @@ MIT in each case. |# (define rtl:make-interpreter-call:unbound?) (let ((interpreter-lookup-maker (lambda (%make) - (lambda (environment name) + (lambda (cont environment name) (expression-simplify-for-statement environment (lambda (environment) - (%make environment name))))))) + (%make cont environment name))))))) (set! rtl:make-interpreter-call:access (interpreter-lookup-maker %make-interpreter-call:access)) (set! rtl:make-interpreter-call:unassigned? @@ -181,38 +181,38 @@ MIT in each case. |# (define rtl:make-interpreter-call:set!) (let ((interpreter-assignment-maker (lambda (%make) - (lambda (environment name value) + (lambda (cont environment name value) (expression-simplify-for-statement value (lambda (value) (expression-simplify-for-statement environment (lambda (environment) - (%make environment name value))))))))) + (%make cont environment name value))))))))) (set! rtl:make-interpreter-call:define (interpreter-assignment-maker %make-interpreter-call:define)) (set! rtl:make-interpreter-call:set! (interpreter-assignment-maker %make-interpreter-call:set!))) -(define (rtl:make-interpreter-call:lookup environment name safe?) +(define (rtl:make-interpreter-call:lookup cont environment name safe?) (expression-simplify-for-statement environment (lambda (environment) - (%make-interpreter-call:lookup environment name safe?)))) + (%make-interpreter-call:lookup cont environment name safe?)))) -(define (rtl:make-interpreter-call:cache-assignment name value) +(define (rtl:make-interpreter-call:cache-assignment cont name value) (expression-simplify-for-statement name (lambda (name) (expression-simplify-for-statement value (lambda (value) - (%make-interpreter-call:cache-assignment name value)))))) + (%make-interpreter-call:cache-assignment cont name value)))))) -(define (rtl:make-interpreter-call:cache-reference name safe?) +(define (rtl:make-interpreter-call:cache-reference cont name safe?) (expression-simplify-for-statement name (lambda (name) - (%make-interpreter-call:cache-reference name safe?)))) + (%make-interpreter-call:cache-reference cont name safe?)))) -(define (rtl:make-interpreter-call:cache-unassigned? name) +(define (rtl:make-interpreter-call:cache-unassigned? cont name) (expression-simplify-for-statement name (lambda (name) - (%make-interpreter-call:cache-unassigned? name)))) + (%make-interpreter-call:cache-unassigned? cont name)))) ;;;; Expression Simplification diff --git a/v7/src/compiler/rtlbase/rtlty1.scm b/v7/src/compiler/rtlbase/rtlty1.scm index facf69d00..e8f1a6807 100644 --- a/v7/src/compiler/rtlbase/rtlty1.scm +++ b/v7/src/compiler/rtlbase/rtlty1.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.19 1991/10/25 00:14:27 cph Exp $ +$Id: rtlty1.scm,v 4.20 1992/11/09 18:42:11 jinx Exp $ -Copyright (c) 1987-91 Massachusetts Institute of Technology +Copyright (c) 1987-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -107,24 +107,30 @@ MIT in each case. |# (define-rtl-expression address->fixnum rtl: expression) ;;; Machine integer arithmetic operations -(define-rtl-expression fixnum-1-arg rtl: operator operand overflow?) -(define-rtl-expression fixnum-2-args rtl: operator operand-1 operand-2 - overflow?) +(define-rtl-expression fixnum-1-arg rtl: + operator operand overflow?) +(define-rtl-expression fixnum-2-args rtl: + operator operand-1 operand-2 overflow?) ;;; Conversion between flonums and machine floats (define-rtl-expression float->object rtl: expression) (define-rtl-expression object->float rtl: expression) ;;; Floating-point arithmetic operations -(define-rtl-expression flonum-1-arg rtl: operator operand overflow?) -(define-rtl-expression flonum-2-args rtl: operator operand-1 operand-2 - overflow?) +(define-rtl-expression flonum-1-arg rtl: + operator operand overflow?) +(define-rtl-expression flonum-2-args rtl: + operator operand-1 operand-2 overflow?) -(define-rtl-predicate fixnum-pred-1-arg % predicate operand) -(define-rtl-predicate fixnum-pred-2-args % predicate operand-1 operand-2) +(define-rtl-predicate fixnum-pred-1-arg % + predicate operand) +(define-rtl-predicate fixnum-pred-2-args % + predicate operand-1 operand-2) -(define-rtl-predicate flonum-pred-1-arg % predicate operand) -(define-rtl-predicate flonum-pred-2-args % predicate operand-1 operand-2) +(define-rtl-predicate flonum-pred-1-arg % + predicate operand) +(define-rtl-predicate flonum-pred-2-args % + predicate operand-1 operand-2) (define-rtl-predicate eq-test % expression-1 expression-2) (define-rtl-predicate type-test % expression type) @@ -142,31 +148,50 @@ MIT in each case. |# (define-rtl-statement procedure-header rtl: procedure min max) (define-rtl-statement closure-header rtl: procedure nentries entry) -(define-rtl-statement interpreter-call:access % environment name) -(define-rtl-statement interpreter-call:define % environment name value) -(define-rtl-statement interpreter-call:lookup % environment name safe?) -(define-rtl-statement interpreter-call:set! % environment name value) -(define-rtl-statement interpreter-call:unassigned? % environment name) -(define-rtl-statement interpreter-call:unbound? % environment name) - -(define-rtl-statement interpreter-call:cache-assignment % name value) -(define-rtl-statement interpreter-call:cache-reference % name safe?) -(define-rtl-statement interpreter-call:cache-unassigned? % name) - -(define-rtl-statement invocation:apply rtl: pushed continuation) -(define-rtl-statement invocation:jump rtl: pushed continuation procedure) -(define-rtl-statement invocation:computed-jump rtl: pushed continuation) -(define-rtl-statement invocation:lexpr rtl: pushed continuation procedure) -(define-rtl-statement invocation:computed-lexpr rtl: pushed continuation) -(define-rtl-statement invocation:uuo-link rtl: pushed continuation name) -(define-rtl-statement invocation:global-link rtl: pushed continuation name) -(define-rtl-statement invocation:primitive rtl: pushed continuation procedure) -(define-rtl-statement invocation:special-primitive rtl: pushed continuation - procedure) -(define-rtl-statement invocation:cache-reference rtl: pushed continuation name) -(define-rtl-statement invocation:lookup rtl: pushed continuation environment - name) - -(define-rtl-statement invocation-prefix:move-frame-up rtl: frame-size locative) -(define-rtl-statement invocation-prefix:dynamic-link rtl: frame-size locative - register) \ No newline at end of file +(define-rtl-statement interpreter-call:access % + continuation environment name) +(define-rtl-statement interpreter-call:define % + continuation environment name value) +(define-rtl-statement interpreter-call:lookup % + continuation environment name safe?) +(define-rtl-statement interpreter-call:set! % + continuation environment name value) +(define-rtl-statement interpreter-call:unassigned? % + continuation environment name) +(define-rtl-statement interpreter-call:unbound? % + continuation environment name) + +(define-rtl-statement interpreter-call:cache-assignment % + continuation name value) +(define-rtl-statement interpreter-call:cache-reference % + continuation name safe?) +(define-rtl-statement interpreter-call:cache-unassigned? % + continuation name) + +(define-rtl-statement invocation:apply rtl: + pushed continuation) +(define-rtl-statement invocation:jump rtl: + pushed continuation procedure) +(define-rtl-statement invocation:computed-jump rtl: + pushed continuation) +(define-rtl-statement invocation:lexpr rtl: + pushed continuation procedure) +(define-rtl-statement invocation:computed-lexpr rtl: + pushed continuation) +(define-rtl-statement invocation:uuo-link rtl: + pushed continuation name) +(define-rtl-statement invocation:global-link rtl: + pushed continuation name) +(define-rtl-statement invocation:primitive rtl: + pushed continuation procedure) +(define-rtl-statement invocation:special-primitive rtl: + pushed continuation procedure) +(define-rtl-statement invocation:cache-reference rtl: + pushed continuation name) +(define-rtl-statement invocation:lookup rtl: + pushed continuation environment name) + +(define-rtl-statement invocation-prefix:move-frame-up rtl: + frame-size locative) +(define-rtl-statement invocation-prefix:dynamic-link rtl: + frame-size locative register) \ No newline at end of file diff --git a/v7/src/compiler/rtlgen/rgproc.scm b/v7/src/compiler/rtlgen/rgproc.scm index 1dfa3ae9b..dcc031cad 100644 --- a/v7/src/compiler/rtlgen/rgproc.scm +++ b/v7/src/compiler/rtlgen/rgproc.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgproc.scm,v 4.12 1990/05/03 15:11:55 jinx Rel $ +$Id: rgproc.scm,v 4.13 1992/11/09 18:43:08 jinx Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -105,15 +105,17 @@ MIT in each case. |# (map (let ((block (procedure-block procedure))) (lambda (name value) (generate/rvalue value scfg*scfg->scfg! - (lambda (expression) - (load-temporary-register scfg*scfg->scfg! expression - (lambda (expression) - (wrap-with-continuation-entry - context + (lambda (expression) + (load-temporary-register scfg*scfg->scfg! expression + (lambda (expression) + (wrap-with-continuation-entry + context + (lambda (cont-label) (rtl:make-interpreter-call:set! + cont-label (rtl:make-fetch register:environment) (intern-scode-variable! block (variable-name name)) - expression)))))))) + expression))))))))) (procedure-names procedure) (procedure-values procedure)))) diff --git a/v7/src/compiler/rtlgen/rgrval.scm b/v7/src/compiler/rtlgen/rgrval.scm index 67c2d6251..83c5d0c1b 100644 --- a/v7/src/compiler/rtlgen/rgrval.scm +++ b/v7/src/compiler/rtlgen/rgrval.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rgrval.scm,v 4.18 1992/11/08 04:07:53 jinx Exp $ +$Id: rgrval.scm,v 4.19 1992/11/09 18:42:52 jinx Exp $ Copyright (c) 1988-1992 Massachusetts Institute of Technology @@ -84,12 +84,14 @@ MIT in each case. |# (lambda (environment) (wrap-with-continuation-entry context - (rtl:make-interpreter-call:lookup - environment - (intern-scode-variable! - (reference-context/block context) - name) - safe?)))) + (lambda (cont-label) + (rtl:make-interpreter-call:lookup + cont-label + environment + (intern-scode-variable! + (reference-context/block context) + name) + safe?))))) (rtl:interpreter-call-result:lookup))) (lambda (name) (if (memq 'IGNORE-REFERENCE-TRAPS @@ -129,7 +131,9 @@ MIT in each case. |# (n4 (wrap-with-continuation-entry context - (rtl:make-interpreter-call:cache-reference cell safe?))) + (lambda (cont-label) + (rtl:make-interpreter-call:cache-reference + cont-label cell safe?)))) (n5 (rtl:make-assignment result diff --git a/v7/src/compiler/rtlgen/rgstmt.scm b/v7/src/compiler/rtlgen/rgstmt.scm index 5ce99ca64..8d03bf787 100644 --- a/v7/src/compiler/rtlgen/rgstmt.scm +++ b/v7/src/compiler/rtlgen/rgstmt.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgstmt.scm,v 4.15 1990/05/03 15:12:04 jinx Rel $ +$Id: rgstmt.scm,v 4.16 1992/11/09 18:43:28 jinx Exp $ -Copyright (c) 1988, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -57,12 +57,14 @@ MIT in each case. |# (lambda (expression) (wrap-with-continuation-entry context - (rtl:make-interpreter-call:set! - environment - (intern-scode-variable! - (reference-context/block context) - name) - expression))))))) + (lambda (cont-label) + (rtl:make-interpreter-call:set! + cont-label + environment + (intern-scode-variable! + (reference-context/block context) + name) + expression)))))))) (lambda (name) (if (memq 'IGNORE-ASSIGNMENT-TRAPS (variable-declarations lvalue)) @@ -88,7 +90,9 @@ MIT in each case. |# (n5 (wrap-with-continuation-entry context - (rtl:make-interpreter-call:cache-assignment cell value))) + (lambda (cont-label) + (rtl:make-interpreter-call:cache-assignment + cont-label cell value)))) ;; Copy prevents premature control merge which confuses CSE (n6 (rtl:make-assignment cell value))) (pcfg-consequent-connect! n2 n3) @@ -115,9 +119,12 @@ MIT in each case. |# (lambda (expression) (wrap-with-continuation-entry context - (rtl:make-interpreter-call:define environment - name - expression)))))))))))) + (lambda (cont-label) + (rtl:make-interpreter-call:define + cont-label + environment + name + expression))))))))))))) ;;;; Virtual Returns @@ -286,8 +293,11 @@ MIT in each case. |# (lambda (environment) (wrap-with-continuation-entry context - (rtl:make-interpreter-call:unassigned? environment - name)))) + (lambda (cont-label) + (rtl:make-interpreter-call:unassigned? + cont-label + environment + name))))) (rtl:make-true-test (rtl:interpreter-call-result:unassigned?)))) (lambda (name) @@ -311,7 +321,10 @@ MIT in each case. |# (n4 (wrap-with-continuation-entry context - (rtl:make-interpreter-call:cache-unassigned? cell))) + (lambda (cont-label) + (rtl:make-interpreter-call:cache-unassigned? + cont-label + cell)))) (n5 (rtl:make-true-test (rtl:interpreter-call-result:cache-unassigned?)))) diff --git a/v7/src/compiler/rtlgen/rtlgen.scm b/v7/src/compiler/rtlgen/rtlgen.scm index 793b394d8..7be0dccce 100644 --- a/v7/src/compiler/rtlgen/rtlgen.scm +++ b/v7/src/compiler/rtlgen/rtlgen.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rtlgen.scm,v 4.28 1992/09/30 21:02:16 cph Exp $ +$Id: rtlgen.scm,v 4.29 1992/11/09 18:42:41 jinx Exp $ -Copyright (c) 1988-92 Massachusetts Institute of Technology +Copyright (c) 1988-1992 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -33,6 +33,7 @@ promotional, or sales literature without prior written consent from MIT in each case. |# ;;;; RTL Generation +;;; package: (compiler rtl-generator) (declare (usual-integrations)) @@ -204,11 +205,12 @@ MIT in each case. |# (and (primitive-procedure? obj) (special-primitive-handler obj))))) -(define (wrap-with-continuation-entry context scfg) +(define (wrap-with-continuation-entry context scfg-gen) (with-values (lambda () (generate-continuation-entry context)) (lambda (label setup cleanup) - label - (scfg-append! setup scfg cleanup)))) + (scfg-append! setup + (scfg-gen label) + cleanup)))) (define (generate-continuation-entry context) (let ((label (generate-label)) -- 2.25.1