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 31b26c25c9c5b02938c686963ec2502785820a49..b74ea0dd25be77cdb31d935f2592b7e6980442bb 100644 (file)
--- 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 74f80ecba2819d924a87622d6ada44f2e7496383..726fef23a984f124f62cbf1e38011dfbf06abda5 100644 (file)
--- 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))))
 \f
 (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 284ad7089d7e2674402a35e13f1bbe2aaca8ced4..7b8af028d37d4166e5f85121b4bc8967a3793f1f 100644 (file)
--- 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)))))))
 \f
 (define (make-non-trivial-closure-cons procedure block**)
   (let* ((block (procedure-closing-block procedure))