* Change variable-indirection pass to occur after closure analysis.

Disable variable-indirection if either the source or target variable
is closed-over.

* Change RTL code-compression to permit compression of
`offset-address' expressions across multiple instructions.  Add two
new rules needed to accomplish this for the standard static-link setup
code.  The goal of this modification is to permit the use of the "pea"
instruction when pushing static-links.

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index 3a0362ec15945dbe99e1bd2536155922fe8922b4..de4d6cfcd673f615e6136f47c29c263619d4fc6c 100644 (file)
--- a/v7/src/compiler/base/toplev.scm
+++ b/v7/src/compiler/base/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.22 1989/10/26 07:36:07 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.23 1989/11/02 08:08:04 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -586,10 +586,11 @@ MIT in each case. |#
       (phase/fold-constants)
       (phase/open-coding-analysis)
       (phase/operator-analysis)
-      (phase/variable-indirection)
       (phase/environment-optimization)
       (phase/identify-closure-limits)
-      (phase/setup-block-types)      (phase/compute-call-graph)
+      (phase/setup-block-types)
+      (phase/variable-indirection)
+      (phase/compute-call-graph)
       (phase/side-effect-analysis)
       (phase/continuation-analysis)
       (phase/subproblem-analysis)

diff --git a/v7/src/compiler/fgopt/varind.scm b/v7/src/compiler/fgopt/varind.scm
index 27100e4c4f45ab51c237a8dfd2ae1fb84e8dd152..12dd686f32df4cd2ba45532021f3d7e54e83f079 100644 (file)
--- a/v7/src/compiler/fgopt/varind.scm
+++ b/v7/src/compiler/fgopt/varind.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/varind.scm,v 1.2 1989/10/27 07:27:13 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/varind.scm,v 1.3 1989/11/02 08:08:21 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -53,6 +53,7 @@ MIT in each case. |#
        (let ((block (variable-block variable)))
          (and (not (lvalue-known-value variable))
               (null? (variable-assignments variable))
+              (not (variable-closed-over? variable))
               (not (lvalue/source? variable))
               (not (block-passed-out? block))
               (let ((indirection
@@ -64,7 +65,9 @@ MIT in each case. |#
                                    (car links)))))
                        (and possibility
                             (lvalue/variable? possibility)
-                            (null? (variable-assignments possibility))                      (let ((block* (variable-block possibility)))
+                            (null? (variable-assignments possibility))
+                            (not (variable-closed-over? possibility))
+                            (let ((block* (variable-block possibility)))
                               (and (not (block-passed-out? block*))
                                    (block-ancestor? block block*)))
                             (begin

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index d550d4a41164bcb0570852d07d50b11599c25637..dd00844e730caca39bb81a53b4ec08e035e658fb 100644 (file)
--- a/v7/src/compiler/machines/bobcat/make.scm-68040
+++ b/v7/src/compiler/machines/bobcat/make.scm-68040
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.57 1989/10/27 07:57:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.58 1989/11/02 08:08:54 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -41,4 +41,4 @@ MIT in each case. |#
            ((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
          '((COMPILER MACROS)
            (COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (Motorola MC68020)" 4 57 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (Motorola MC68020)" 4 58 '()))
\ No newline at end of file

diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm
index 44eb2d3f9a062d9eaf4ddee431b447541200306e..89d1e4b4ed0759819b77b2c2e1e638f341ca9495 100644 (file)
--- a/v7/src/compiler/machines/bobcat/rules1.scm
+++ b/v7/src/compiler/machines/bobcat/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.27 1989/10/26 07:37:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.28 1989/11/02 08:08:36 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -86,23 +86,42 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n)))
-  (QUALIFIER (and (pseudo-register? target) (machine-register? source)))
-  (let ((source (indirect-reference! source n)))
-    (delete-dead-registers!)
-    (LAP (LEA ,source ,(reference-target-alias! target 'ADDRESS)))))
+  (QUALIFIER (pseudo-word? target))
+  (load-static-link target source n false))
 
 (define-rule statement
-  (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n)))
-  (QUALIFIER (and (pseudo-word? target) (pseudo-register? source)))
-  (reuse-pseudo-register-alias! source 'DATA
-    (lambda (reusable-alias)
-      (delete-dead-registers!)
-      (add-pseudo-register-alias! target reusable-alias)
-      (increment-machine-register reusable-alias n))
-    (lambda ()
-      (let ((source (indirect-reference! source n)))
-       (delete-dead-registers!)
-       (LAP (LEA ,source ,(reference-target-alias! target 'ADDRESS)))))))
+  (ASSIGN (REGISTER (? target))
+         (CONS-POINTER (CONSTANT (? type))
+                       (OFFSET-ADDRESS (REGISTER (? source)) (? n))))
+  (QUALIFIER (pseudo-word? target))
+  (load-static-link target source n
+    (lambda (target)
+      (LAP (OR UL (& ,(make-non-pointer-literal type 0)) ,target)))))
+
+(define (load-static-link target source n suffix)
+  (let ((non-reusable
+        (lambda ()
+          (let ((source (indirect-reference! source n)))
+            (delete-dead-registers!)
+            (if suffix
+                (let ((temp (reference-temporary-register! 'ADDRESS)))
+                  (let ((target (reference-target-alias! target 'DATA)))
+                    (LAP (LEA ,source ,temp)
+                         (MOV L ,temp ,target)
+                         ,@(suffix target))))
+                (LAP (LEA ,source
+                          ,(reference-target-alias! target 'ADDRESS))))))))
+    (if (machine-register? source)
+       (non-reusable)
+       (reuse-pseudo-register-alias! source 'DATA
+         (lambda (reusable-alias)
+           (delete-dead-registers!)
+           (add-pseudo-register-alias! target reusable-alias)
+           (LAP ,@(increment-machine-register reusable-alias n)
+                ,@(if suffix
+                      (suffix (register-reference reusable-alias))
+                      (LAP))))
+         non-reusable))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (CONSTANT (? source)))
@@ -329,6 +348,16 @@ MIT in each case. |#
     (LAP (MOV L ,(standard-register-reference datum 'DATA true) ,target)
         ,(memory-set-type type target))))
 
+(define-rule statement
+  (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
+         (CONS-POINTER (CONSTANT (? type))
+                       (OFFSET-ADDRESS (REGISTER (? source)) (? n))))
+  (let ((temp (reference-temporary-register! 'ADDRESS))
+       (target (indirect-reference! address offset)))
+    (LAP (LEA ,(indirect-reference! source n) ,temp)
+        (MOV L ,temp ,target)
+        ,(memory-set-type type target))))
+
 (define-rule statement
   (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
          (CONS-POINTER (CONSTANT (? type)) (ENTRY:PROCEDURE (? label))))
@@ -424,17 +453,26 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
-         (OFFSET-ADDRESS (REGISTER (? r)) (? n)))
-  (LAP (PEA ,(indirect-reference! r n))))
-
-(define-rule statement
-  (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (OFFSET (REGISTER (? r)) (? n)))
-  (LAP (MOV L ,(indirect-reference! r n) (@-A 7))))
+         (CONS-POINTER (CONSTANT (? type)) (ENTRY:CONTINUATION (? label))))
+  (LAP (PEA (@PCR ,label))
+       ,(memory-set-type type (INST-EA (@A 7)))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (ENTRY:CONTINUATION (? label)))
   (LAP (PEA (@PCR ,label))
        ,(memory-set-type (ucode-type compiled-entry) (INST-EA (@A 7)))))
+
+(define-rule statement
+  (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
+         (CONS-POINTER (CONSTANT (? type))
+                       (OFFSET-ADDRESS (REGISTER (? r)) (? n))))
+  (LAP (PEA ,(indirect-reference! r n))
+       ,(memory-set-type type (INST-EA (@A 7)))))
+
+(define-rule statement
+  (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (OFFSET (REGISTER (? r)) (? n)))
+  (LAP (MOV L ,(indirect-reference! r n) (@-A 7))))
+
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
          (FIXNUM->OBJECT (REGISTER (? r))))

diff --git a/v7/src/compiler/rtlopt/rcompr.scm b/v7/src/compiler/rtlopt/rcompr.scm
index bcbb35e01b58ef6b1fe009bfe8e34e9c9aa27b99..9f39dd649ea856a367e6bb12bb431b5fd939bae1 100644 (file)
--- a/v7/src/compiler/rtlopt/rcompr.scm
+++ b/v7/src/compiler/rtlopt/rcompr.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcompr.scm,v 1.8 1988/12/12 21:30:30 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcompr.scm,v 1.9 1989/11/02 08:07:46 cph Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988. 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -114,6 +114,10 @@ MIT in each case. |#
              (or (and (rtl:assign? rtl)
                       (equal? (rtl:assign-address rtl) expression))
                  (expression-clobbers-stack-pointer? rtl)))))
+         ((and (rtl:offset-address? expression)
+               (interpreter-stack-pointer?
+                (rtl:offset-address-register expression)))
+          (search-stopping-at expression-clobbers-stack-pointer?))
          ((rtl:constant-expression? expression)
           (let loop ((next (rinst-next next)))
             (if (rinst-dead-register? next register)
@@ -138,3 +142,29 @@ MIT in each case. |#
                    (rtl:post-increment-register expression)))
                  (else
                   (loop expression))))))))
+\f
+(define (fold-instructions! live rinst next register expression)
+  ;; Attempt to fold `expression' into the place of `register' in the
+  ;; RTL instruction `next'.  If the resulting instruction is
+  ;; reasonable (i.e. if the LAP generator informs us that it has a
+  ;; pattern for generating that instruction), the folding is
+  ;; performed.
+  (let ((rtl (rinst-rtl next)))
+    (if (rtl:refers-to-register? rtl register)
+       (let ((rtl (rtl:subst-register rtl register expression)))
+         (if (lap-generator/match-rtl-instruction rtl)
+             (begin
+               (set-rinst-rtl! rinst false)
+               (set-rinst-rtl! next rtl)
+               (let ((dead (rinst-dead-registers rinst)))
+                 (for-each increment-register-live-length! dead)
+                 (set-rinst-dead-registers!
+                  next
+                  (eqv-set-union dead
+                                 (delv! register
+                                        (rinst-dead-registers next)))))
+               (for-each-regset-member live decrement-register-live-length!)
+               (reset-register-n-refs! register)
+               (reset-register-n-deaths! register)
+               (reset-register-live-length! register)
+               (set-register-bblock! register false)))))))
\ No newline at end of file