From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Fri, 9 Jul 1993 00:15:16 +0000 (+0000)
Subject: Fix a bug in closure bumping.  The code was written in a hybrid of
X-Git-Tag: 20090517-FFI~8203
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c4ea11826ba2b7f9d3a48c70fd8e6786f071ac0f;p=mit-scheme.git

Fix a bug in closure bumping.  The code was written in a hybrid of
locative-level rtl and "real" rtl.
---

diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm
index 31b26c25c..b74ea0dd2 100644
--- a/v7/src/compiler/rtlbase/rtlcon.scm
+++ b/v7/src/compiler/rtlbase/rtlcon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rtlcon.scm,v 4.26 1993/07/01 03:25:31 gjr Exp $
+$Id: rtlcon.scm,v 4.27 1993/07/09 00:15:05 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -435,13 +435,21 @@ MIT in each case. |#
    (lambda (receiver scfg-append!)
      scfg-append!			;ignore
      (lambda (address offset granularity)
-       (if (not (eq? granularity 'OBJECT))
-	   (error "can't take address of non-object offset" granularity))
        (receiver
-	(if (zero? offset)
-	    address
-	    (rtl:make-offset-address address
-				     (rtl:make-machine-constant offset))))))))
+	(case granularity
+	  ((OBJECT)
+	   (if (zero? offset)
+	       address
+	       (rtl:make-offset-address address
+					(rtl:make-machine-constant offset))))
+	  ((BYTE)
+	   (rtl:make-byte-offset-address address
+					 (rtl:make-machine-constant offset)))
+	  ((FLOAT)
+	   (rtl:make-float-offset-address address
+					  (rtl:make-machine-constant offset)))
+	  (else
+	   (error "ADDRESS: Unknown granularity" granularity))))))))
 
 (define-expression-method 'ENVIRONMENT
   (address-method
diff --git a/v7/src/compiler/rtlgen/rgcomb.scm b/v7/src/compiler/rtlgen/rgcomb.scm
index 74f80ecba..726fef23a 100644
--- a/v7/src/compiler/rtlgen/rgcomb.scm
+++ b/v7/src/compiler/rtlgen/rgcomb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rgcomb.scm,v 4.19 1993/07/08 21:56:26 gjr Exp $
+$Id: rgcomb.scm,v 4.20 1993/07/09 00:15:10 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -134,23 +134,17 @@ MIT in each case. |#
 	(let ((locative
 	       (rtl:locative-offset
 		(rtl:make-fetch (interpreter-stack-pointer))
-		(rtl:make-machine-constant (stack->memory-offset 0)))))
+		(stack->memory-offset 0))))
 	  (scfg*scfg->scfg!
-	   (rtl:make-assignment
-	    locative
-	    (rtl:bump-closure (rtl:make-fetch locative)
-			      (rtl:make-machine-constant distance)))
+	   (rtl:make-assignment locative
+				(rtl:bump-closure (rtl:make-fetch locative)
+						  distance))
 	   call-code)))))
 
 (define (rtl:bump-closure closure distance)
-  #|
-  ;; We want this, but it doesn't type check.
-  ;; It is turned into this by a rewrite rule.
-  (rtl:make-byte-offset-address closure distance)
-  |#
   (rtl:make-typed-cons:procedure
-   (rtl:make-byte-offset-address (rtl:make-object->address closure)
-				 distance)))
+   (rtl:make-address
+    (rtl:locative-byte-offset closure distance))))
 
 (define (invocation/apply model operator frame-size continuation prefix)
   model operator			; ignored
diff --git a/v7/src/compiler/rtlgen/rgrval.scm b/v7/src/compiler/rtlgen/rgrval.scm
index 284ad7089..7b8af028d 100644
--- a/v7/src/compiler/rtlgen/rgrval.scm
+++ b/v7/src/compiler/rtlgen/rgrval.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rgrval.scm,v 4.21 1993/07/01 03:27:12 gjr Exp $
+$Id: rgrval.scm,v 4.22 1993/07/09 00:15:16 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -276,8 +276,7 @@ MIT in each case. |#
 		(closure-environment-adjustment nentries entry))))
 	  (if (back-end:= distance 0)
 	      expression
-	      (rtl:bump-closure expression
-				(rtl:make-machine-constant distance))))))))
+	      (rtl:bump-closure expression distance)))))))
 
 (define (make-non-trivial-closure-cons procedure block**)
   (let* ((block (procedure-closing-block procedure))