Strip down code generated for primitive memory references.

diff --git a/src/compiler/rtlgen/opncod.scm b/src/compiler/rtlgen/opncod.scm
index 35ab015bcdf834699bbc79aa500ff7726f0758b6..686200207f3f07d60080f6427f62c6f9e79f9d6c 100644 (file)
--- a/src/compiler/rtlgen/opncod.scm
+++ b/src/compiler/rtlgen/opncod.scm
@@ -502,6 +502,13 @@ USA.
         name
         expressions)))))
 
+(define (raw-indexed-memory-reference index-locative)
+  (lambda (name base-type value-type generator)
+    (lambda (combination expressions finish)
+      (index-locative (car expressions) (cadr expressions)
+       (lambda (locative)
+         (generator locative expressions finish))))))
+
 (define (index-locative-generator make-constant-locative
                                  make-variable-locative
                                  header-length-in-units
@@ -526,14 +533,20 @@ USA.
                (unknown-index)))
          (unknown-index)))))
 \f
-(define object-memory-reference
-  (indexed-memory-reference
-   (lambda (expression) expression false)
+(define raw-object-memory-reference
+  (raw-indexed-memory-reference
    (index-locative-generator rtl:locative-object-offset
                             rtl:locative-object-index
                             0
                             scfg*scfg->scfg!)))
 
+(define raw-byte-memory-reference
+  (raw-indexed-memory-reference
+   (index-locative-generator rtl:locative-byte-offset
+                            rtl:locative-byte-index
+                            0
+                            scfg*scfg->scfg!)))
+
 (define vector-memory-reference
   (indexed-memory-reference
    (lambda (expression) (rtl:make-fetch (rtl:locative-offset expression 0)))
@@ -1057,7 +1070,7 @@ USA.
 
 (define-open-coder/value 'PRIMITIVE-OBJECT-REF
   (simple-open-coder
-   (object-memory-reference 'PRIMITIVE-OBJECT-REF false false
+   (raw-object-memory-reference 'PRIMITIVE-OBJECT-REF false false
     (lambda (locative expressions finish)
       expressions
       (finish (rtl:make-fetch locative))))
@@ -1066,7 +1079,7 @@ USA.
 
 (define-open-coder/value 'PRIMITIVE-BYTE-REF
   (simple-open-coder
-   (byte-memory-reference 'PRIMITIVE-BYTE-REF false false
+   (raw-byte-memory-reference 'PRIMITIVE-BYTE-REF false false
     (lambda (locative expressions finish)
       expressions
       (finish (rtl:make-fetch locative))))
@@ -1112,7 +1125,7 @@ USA.
 
 (define-open-coder/effect 'PRIMITIVE-OBJECT-SET!
   (simple-open-coder
-   (object-memory-reference 'PRIMITIVE-OBJECT-SET! false false
+   (raw-object-memory-reference 'PRIMITIVE-OBJECT-SET! false false
     (lambda (locative expressions finish)
       (finish-vector-assignment locative
                                (caddr expressions)
@@ -1122,7 +1135,7 @@ USA.
 
 (define-open-coder/effect 'PRIMITIVE-BYTE-SET!
   (simple-open-coder
-   (byte-memory-reference 'PRIMITIVE-BYTE-SET! false false
+   (raw-byte-memory-reference 'PRIMITIVE-BYTE-SET! false false
     (lambda (locative expressions finish)
       (finish-vector-assignment locative
                                (caddr expressions)