Change `cons-closure' from a statement to an expression. This allows

us more freedom in choosing the target register.

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index 61b74e5807fe20e53a876848d35670dfc821f782..7c640923206926208609f9739ddfa93662e58a4a 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.28 1988/11/06 14:55:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.29 1988/11/08 11:17:29 cph Exp $
 
 Copyright (c) 1988 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" 4 28 '()))
\ No newline at end of file
+(add-system! (make-system "Liar" 4 29 '()))
\ No newline at end of file

diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm
index 025b9daf0fe05b3f7a143fd3678b0c866ea4147a..4fb64e1ed6b83a365151d016e03fcbaa51644ead 100644 (file)
--- a/v7/src/compiler/machines/bobcat/rules3.scm
+++ b/v7/src/compiler/machines/bobcat/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.12 1988/11/01 22:52:45 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.13 1988/11/08 11:11:27 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -394,21 +394,25 @@ MIT in each case. |#
           (B GE B (@PCR ,gc-label))))))
 
 (define-rule statement
-  (CONS-CLOSURE (ENTRY:PROCEDURE (? internal-label)) (? min) (? max) (? size))
-  (let* ((temp (allocate-temporary-register! 'ADDRESS))
-        (temp-ref (register-reference temp)))
+  (ASSIGN (REGISTER (? target))
+         (CONS-POINTER (CONSTANT (? type))
+                       (CONS-CLOSURE (ENTRY:PROCEDURE (? internal-label))
+                                     (? min) (? max) (? size))))
+  (QUALIFIER (pseudo-register? target))
+  (let ((temporary (reference-temporary-register! 'ADDRESS))
+       (target (reference-target-alias! target 'DATA)))
     (LAP (LEA (@PCR ,(rtl-procedure/external-label
                      (label->object internal-label)))
-             ,temp-ref)
-        ,(load-non-pointer (ucode-type manifest-closure) (+ 3 size)
+             ,temporary)
+        ,(load-non-pointer (ucode-type manifest-closure)
+                           (+ 3 size)
                            (INST-EA (@A+ 5)))
-        (MOVE L (& ,(+ (* (make-procedure-code-word min max) #x10000)
-                       #x8))
+        (MOVE L (& ,(+ (* (make-procedure-code-word min max) #x10000) 8))
               (@A+ 5))
-        (MOVE L (A 5) ,reg:enclose-result)
-        (MOVE B (& ,(ucode-type compiled-entry)) ,reg:enclose-result)
-        (MOVE W (& #x4eb9) (@A+ 5))                    ; (JSR (L <entry>))
-        (MOVE L ,temp-ref (@A+ 5))
+        (MOVE L (A 5) ,target)
+        (OR L (& ,(make-non-pointer-literal type 0)) ,target)
+        (MOVE W (& #x4eb9) (@A+ 5))    ; (JSR (L <entry>))
+        (MOVE L ,temporary (@A+ 5))
         (CLR W (@A+ 5))
         ,@(increment-machine-register 13 size))))
 \f

diff --git a/v7/src/compiler/rtlgen/rgproc.scm b/v7/src/compiler/rtlgen/rgproc.scm
index 0739a04229e3d99755502a05544d61b4da0b960a..65e5b6c6265b7a193bf45860b08921ceee4ba098 100644 (file)
--- a/v7/src/compiler/rtlgen/rgproc.scm
+++ b/v7/src/compiler/rtlgen/rgproc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgproc.scm,v 4.4 1988/11/01 04:55:01 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgproc.scm,v 4.5 1988/11/08 11:14:32 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -155,8 +155,8 @@ MIT in each case. |#
                  (error "Letrec value is trivial closure" value)
                  (recvr (make-null-cfg)
                         (make-trivial-closure-cons value)))
-               (recvr (make-non-trivial-closure-cons value)
-                      (rtl:interpreter-call-result:enclose))))
+               (recvr (make-null-cfg)
+                      (make-non-trivial-closure-cons value))))
           ((IC)
            (make-ic-cons value 'USE-ENV recvr))
           ((OPEN-EXTERNAL OPEN-INTERNAL)

diff --git a/v7/src/compiler/rtlgen/rgrval.scm b/v7/src/compiler/rtlgen/rgrval.scm
index a5cae864262759bbace38867d3f2487b1acc4579..636c5190d08c3df2c53edfb53ed56b92dc3a7420 100644 (file)
--- a/v7/src/compiler/rtlgen/rgrval.scm
+++ b/v7/src/compiler/rtlgen/rgrval.scm
@@ -1,9 +1,9 @@
 d3 1
 a4 1
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 4.10 1988/11/04 10:28:39 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 4.11 1988/11/08 11:14:49 cph Exp $
 #| -*-Scheme-*-
 Copyright (c) 1988 Massachusetts Institute of Technology
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 4.10 1988/11/04 10:28:39 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 4.11 1988/11/08 11:14:49 cph Exp $
 
 Copyright (c) 1988, 1990 Massachusetts Institute of Technology
 
@@ -160,12 +160,11 @@ promotional, or sales literature without prior written consent from
           (load-temporary-register
            (lambda (assignment reference)
              (return-2
-              (scfg-append!
-               (make-non-trivial-closure-cons procedure)
+              (scfg*scfg->scfg!
                assignment
                (load-closure-environment procedure offset reference))
               reference))
-           (rtl:interpreter-call-result:enclose)
+           (make-non-trivial-closure-cons procedure)
            identity-procedure)))
         (else
        (make-ic-cons procedure offset
@@ -286,13 +285,15 @@ promotional, or sales literature without prior written consent from
    (rtl:make-entry:procedure (procedure-label procedure))))
 
 (define (make-non-trivial-closure-cons procedure)
-  (with-procedure-arity-encoding procedure
-   (lambda (min max)
-     (rtl:make-cons-closure
-      (rtl:make-entry:procedure (procedure-label procedure))
-      min
-      max
-      (procedure-closure-size procedure)))))
+  (rtl:make-cons-pointer
+   (rtl:make-constant type-code:compiled-entry)
+   (with-procedure-arity-encoding procedure
+     (lambda (min max)
+       (rtl:make-cons-closure
+       (rtl:make-entry:procedure (procedure-label procedure))
+       min
+       max
+       (procedure-closure-size procedure))))))
 
 (define (with-procedure-arity-encoding procedure receiver)
   (let* ((min (1+ (length (procedure-required-arguments procedure))))

diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm
index 96b6a6c3839b266ed3d37dfd6a8ef05f980622cb..83101df4e7d3ae77ee85fbf4a2b08712e89e4ad0 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 4.14 1988/11/05 02:59:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 4.15 1988/11/08 11:15:07 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -311,11 +311,6 @@ MIT in each case. |#
 
 (define-trivial-one-arg-method 'INVOCATION:LOOKUP
   rtl:invocation:lookup-environment rtl:set-invocation:lookup-environment!)
-(define-cse-method 'CONS-CLOSURE
-  (lambda (statement)
-    statement
-    (expression-invalidate! (interpreter-register:enclose))))
-
 (define-cse-method 'INVOCATION-PREFIX:MOVE-FRAME-UP
   (lambda (statement)
     (expression-replace! rtl:invocation-prefix:move-frame-up-locative