From 30ca9e0b9305c3e8325e63fe0ae65b7aca6249ce Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 7 Oct 2006 05:50:22 +0000
Subject: [PATCH] Reorganize closure code slightly to clarify.

---
 v7/src/compiler/machines/C/rules3.scm | 68 +++++++++++++--------------
 1 file changed, 33 insertions(+), 35 deletions(-)

diff --git a/v7/src/compiler/machines/C/rules3.scm b/v7/src/compiler/machines/C/rules3.scm
index 6b530a7e1..4e6b63230 100644
--- a/v7/src/compiler/machines/C/rules3.scm
+++ b/v7/src/compiler/machines/C/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 1.14 2006/10/01 05:38:20 cph Exp $
+$Id: rules3.scm,v 1.15 2006/10/07 05:50:22 cph Exp $
 
 Copyright 1993,2001,2002,2006 Massachusetts Institute of Technology
 
@@ -386,33 +386,33 @@ USA.
 	   ,@(label-statement internal-label)
 	   ,(c:closure-interrupt-check)))))
 
+(define-rule statement
+  (ASSIGN (REGISTER (? target))
+	  (CONS-CLOSURE (ENTRY:PROCEDURE (? procedure-label))
+			(? min) (? max) (? nvars)))
+  (cons-closure target procedure-label min max nvars))
+
+(define (cons-closure target label min max nvars)
+  (let ((target (standard-target! target 'SCHEME_OBJECT*)))
+    (LAP ,(c:= (c:* (c:postinc (c:free-reg)))
+	       (c:make-object "TC_MANIFEST_CLOSURE"
+			      (+ closure-entry-size nvars)))
+	 ,(c:= target (c:+ (c:free-reg) 1))
+	 ,@(write-closure-entry label min max 2)
+	 ,(c:+= (c:free-reg) nvars))))
+
 (define (write-closure-entry internal-label min max offset)
   (let ((external-label
 	 (rtl-procedure/external-label (label->object internal-label))))
-    (LAP ,(c:scall "WRITE_LABEL_DESCRIPTOR"
+    (LAP ,(c:+= (c:free-reg) 1)
+	 ,(c:scall "WRITE_LABEL_DESCRIPTOR"
 		   (c:free-reg)
 		   (c:hex (make-procedure-code-word min max))
 		   offset)
-	 ,(c:= (c:aref (c:free-reg) 0)
+	 ,(c:= (c:* (c:postinc (c:free-reg)))
 	       (c:+ 'dispatch_base (label->dispatch-tag external-label)))
-	 ,(c:= (c:aref (c:free-reg) 1)
+	 ,(c:= (c:* (c:postinc (c:free-reg)))
 	       (c:cast 'sobj (c:cptr (label->offset external-label)))))))
-
-(define (cons-closure target label min max nvars)
-  (let ((target (standard-target! target 'SCHEME_OBJECT*)))
-    (LAP ,(c:= (c:* (c:free-reg))
-	       (c:make-object "TC_MANIFEST_CLOSURE"
-			      (+ closure-entry-size nvars)))
-	 ,(c:+= (c:free-reg) 2)
-	 ,(c:= target (c:free-reg))
-	 ,@(write-closure-entry label min max 2)
-	 ,(c:+= (c:free-reg) (+ nvars 2)))))
-
-(define-rule statement
-  (ASSIGN (REGISTER (? target))
-	  (CONS-CLOSURE (ENTRY:PROCEDURE (? procedure-label))
-			(? min) (? max) (? nvars)))
-  (cons-closure target procedure-label min max nvars))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
@@ -422,10 +422,9 @@ USA.
     ((0)
      (let ((dest (standard-target! target 'SCHEME_OBJECT*)))
        (LAP ,(c:= dest (c:free-reg))
-	    ,(c:= (c:* (c:free-reg))
-		  (c:make-object "TC_MANIFEST_VECTOR"
-				 nvars))
-	    ,(c:+= (c:free-reg) (+ nvars 1)))))
+	    ,(c:= (c:* (c:postinc (c:free-reg)))
+		  (c:make-object "TC_MANIFEST_VECTOR" nvars))
+	    ,(c:+= (c:free-reg) nvars))))
     ((1)
      (let ((entry (vector-ref entries 0)))
        (cons-closure target (car entry) (cadr entry) (caddr entry) nvars)))
@@ -434,25 +433,24 @@ USA.
 
 (define (cons-multiclosure target nentries nvars entries)
   (let ((target (standard-target! target 'SCHEME_OBJECT*)))
-    (LAP ,(c:= (c:* (c:free-reg))
+    (LAP ,(c:= (c:* (c:postinc (c:free-reg)))
 	       (c:make-object "TC_MANIFEST_CLOSURE"
 			      (+ 1 (* nentries closure-entry-size) nvars)))
-	 ,(c:+= (c:free-reg) 2)
-	 ,(c:scall "WRITE_LABEL_DESCRIPTOR" (c:free-reg) nentries 0)
 	 ,(c:+= (c:free-reg) 1)
-	 ,(c:= target (c:free-reg))
+	 ,(c:scall "WRITE_LABEL_DESCRIPTOR" (c:free-reg) nentries 0)
+	 ,(c:= target (c:+ (c:free-reg) 1))
 	 ,@(reduce-right
 	    (lambda (lap1 lap2)
 	      (LAP ,@lap1 ,@lap2))
 	    (LAP)
 	    (map (lambda (entry offset)
-		   (let ((label (car entry))
-			 (min (cadr entry))
-			 (max (caddr entry)))
-		     (LAP ,@(write-closure-entry label min max offset)
-			  ,(c:+= (c:free-reg) 3))))
-		 entries (make-multiclosure-offsets nentries)))
-	 ,(c:+= (c:free-reg) (- nvars 1)))))
+		   (write-closure-entry (car entry)
+					(cadr entry)
+					(caddr entry)
+					offset))
+		 entries
+		 (make-multiclosure-offsets nentries)))
+	 ,(c:+= (c:free-reg) nvars))))
 	 
 (define (make-multiclosure-offsets nentries)
   (let generate ((n nentries) (offset 3))
-- 
2.25.1