From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Mon, 9 Nov 1992 18:50:24 +0000 (+0000)
Subject: Add label argument to all interpreter calls for the C back-end.
X-Git-Tag: 20090517-FFI~8789
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8772c67a497bc2e817b51079d01143d8a382ab01;p=mit-scheme.git
Add label argument to all interpreter calls for the C back-end.
---
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))