From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 8 Nov 1988 11:17:29 +0000 (+0000)
Subject: Change `cons-closure' from a statement to an expression.  This allows
X-Git-Tag: 20090517-FFI~12411
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=67b02f2dfdc75fd8979ccc3d3b482451977b4dc3;p=mit-scheme.git

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 61b74e580..7c6409232 100644
--- 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 025b9daf0..4fb64e1ed 100644
--- 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))))
 
diff --git a/v7/src/compiler/rtlgen/rgproc.scm b/v7/src/compiler/rtlgen/rgproc.scm
index 0739a0422..65e5b6c62 100644
--- 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 a5cae8642..636c5190d 100644
--- 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 96b6a6c38..83101df4e 100644
--- 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