#| -*-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.)
(declare (usual-integrations))
\f
+;;;; 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)))
+\f
;;;; 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)
,@(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
#| -*-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
MIT in each case. |#
;;;; LAP Generation Rules: Interpreter Calls
+;;; package: (compiler lap-syntaxer)
(declare (usual-integrations))
\f
+;;;; 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)))))
+\f
;;;; 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)
(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)
,@(invoke-interface-jsr code)))))
\f
(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)
,@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
#| -*-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
(declare (usual-integrations))
\f
+;;;; 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))))
+\f
;;;; 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)
,@(invoke-interface/call code))))
\f
(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)
,@(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
#| -*-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
MIT in each case. |#
;;;; LAP Generation Rules: Interpreter Calls
+;;; package: (compiler lap-syntaxer)
(declare (usual-integrations))
\f
+;;;; 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)))
+\f
;;;; 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)
,@(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
#| -*-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
MIT in each case. |#
;;;; LAP Generation Rules: Interpreter Calls
+;;; package: (compiler lap-syntaxer)
(declare (usual-integrations))
\f
+;;;; 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)))
+\f
;;;; 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)
,@(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
#| -*-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
;;;; 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!)))
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))
,@(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!)))
;;; 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)
,@(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)
#| -*-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
(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?
(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))))
\f
;;;; Expression Simplification
#| -*-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
(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?)
\f
;;; 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)
(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
#| -*-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
(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))))
#| -*-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
(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
(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
#| -*-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
(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))
(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)
(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)))))))))))))
\f
;;;; Virtual Returns
(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)
(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?))))
#| -*-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
MIT in each case. |#
;;;; RTL Generation
+;;; package: (compiler rtl-generator)
(declare (usual-integrations))
\f
(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))
projects / mit-scheme.git / commitdiff