Add new RTL types for cached variable lookup mechanism.

diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index e81b7adc7b49c58d0c6c28bbd95fddbfa74afca0..826a2d4ad0068580ac5c1dcb4332489b84a8c7b9 100644 (file)
--- a/v7/src/compiler/machines/bobcat/lapgen.scm
+++ b/v7/src/compiler/machines/bobcat/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.170 1987/05/29 21:21:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.171 1987/05/31 23:00:30 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -238,7 +238,8 @@ MIT in each case. |#
     unassigned? unbound? set! define primitive-apply enclose setup-lexpr
     return-to-interpreter safe-lookup cache-variable reference-trap
     assignment-trap)
-  (define-entries #x0228 uuo-link uuo-link-trap))
+  (define-entries #x0228 uuo-link uuo-link-trap cache-reference-apply
+    safe-reference-trap unassigned?-trap))
 
 (define reg:temp '(@AO 6 #x0010))
 (define reg:enclose-result '(@AO 6 #x0014))

diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm
index 2bc9c8595ff9c8b011f875fe6ae1d8608a25be35..c5ad414c6ec38244391d523da60b743e2670aff7 100644 (file)
--- a/v7/src/compiler/machines/bobcat/machin.scm
+++ b/v7/src/compiler/machines/bobcat/machin.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 1.47 1987/05/31 14:14:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 1.48 1987/05/31 23:00:05 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -91,6 +91,8 @@ MIT in each case. |#
     ((INTERPRETER-CALL-RESULT:ACCESS) (interpreter-register:access))
     ((INTERPRETER-CALL-RESULT:CACHE-REFERENCE)
      (interpreter-register:cache-reference))
+    ((INTERPRETER-CALL-RESULT:CACHE-UNASSIGNED?)
+     (interpreter-register:cache-unassigned?))
     ((INTERPRETER-CALL-RESULT:LOOKUP) (interpreter-register:lookup))
     ((INTERPRETER-CALL-RESULT:UNASSIGNED?) (interpreter-register:unassigned?))
     ((INTERPRETER-CALL-RESULT:UNBOUND?) (interpreter-register:unbound?))
@@ -144,7 +146,7 @@ MIT in each case. |#
 
 (define (pseudo-register=? x y)
   (= (register-renumber x) (register-renumber y)))
-
+\f
 (define register-type
   (let ((types (make-vector 16)))
     (let loop ((i 0) (j 8))
@@ -163,15 +165,18 @@ MIT in each case. |#
                 (vector-set! references j `(A ,i))
                 (loop (1+ i) (1+ j)))))    (lambda (register)
       (vector-ref references register))))
-\f
-(define mask-reference '(D 7))
 
+(define mask-reference '(D 7))
+\f
 (define-integrable (interpreter-register:access)
   (rtl:make-machine-register d0))
 
 (define-integrable (interpreter-register:cache-reference)
   (rtl:make-machine-register d0))
 
+(define-integrable (interpreter-register:cache-unassigned?)
+  (rtl:make-machine-register d0))
+
 (define-integrable (interpreter-register:enclose)
   (rtl:make-offset (interpreter-regs-pointer) 5))
 
@@ -207,7 +212,7 @@ MIT in each case. |#
 
 (define-integrable (interpreter-stack-pointer? register)
   (= (rtl:register-number register) regnum:stack-pointer))
-
+\f
 (define (lap:make-label-statement label)
   `(LABEL ,label))
 

diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm
index 49f06cb1313e4cd101c5b9502eff16a2da273d90..3670b7d59d6faff1d66f916873572b53795f10d6 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlcon.scm
+++ b/v7/src/compiler/rtlbase/rtlcon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 1.6 1987/05/29 17:49:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 1.7 1987/05/31 22:56:27 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -136,6 +136,14 @@ MIT in each case. |#
                          (and continuation
                               (continuation-label continuation))))
 
+(define (rtl:make-invocation:cache-reference frame-size prefix continuation
+                                            name)
+  (%make-invocation:cache-reference frame-size
+                                   prefix
+                                   (and continuation
+                                        (continuation-label continuation))
+                                   name))
+
 (define (rtl:make-invocation:jump frame-size prefix continuation procedure)
   (%make-invocation:jump frame-size
                         prefix

diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm
index 9bb67049ff0146a00b2e4441b276ed75fa359fa8..c6cd3dffb244fa22a0f7f9488cc7877a5d35f7e0 100644 (file)
--- a/v7/src/compiler/rtlopt/rcse1.scm
+++ b/v7/src/compiler/rtlopt/rcse1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.105 1987/05/28 17:59:24 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.106 1987/05/31 22:56:55 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -180,8 +180,11 @@ MIT in each case. |#
 (define-cse-method 'CONTINUATION-HEAP-CHECK method/noop)
 (define-cse-method 'INVOCATION:APPLY method/noop)
 (define-cse-method 'INVOCATION:JUMP method/noop)
+(define-cse-method 'INVOCATION:CACHE-REFERENCE method/noop)
 (define-cse-method 'INVOCATION:LEXPR method/noop)
 (define-cse-method 'INVOCATION:PRIMITIVE method/noop)
+(define-cse-method 'INTERPRETER-CALL:CACHE-REFERENCE method/noop)
+(define-cse-method 'INTERPRETER-CALL:CACHE-UNASSIGNED? method/noop)
 
 (define (method/invalidate-stack statement)
   (stack-pointer-invalidate!))
@@ -203,6 +206,16 @@ MIT in each case. |#
                         rtl:set-invocation:lookup-environment!
                         statement
                         trivial-action)))
+
+(define-cse-method 'INTERPRETER-CALL:CACHE-ASSIGNMENT
+  (lambda (statement)
+    (expression-replace! rtl:interpreter-call:cache-assignment-value
+                        rtl:set-interpreter-call:cache-assignment-value!
+                        statement
+      (lambda (volatile? insert-source!)
+       (hash-table-delete-class! element-address-varies?)
+       (non-object-invalidate!)
+       (if (not volatile?) (insert-source!))))))
 \f
 (define (define-lookup-method type get-environment set-environment! register)
   (define-cse-method type