From d54659ff309d4f5a2f6d43edde5efe82923e25f7 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 12 Apr 2017 21:18:27 -0700
Subject: [PATCH] Strip down code generated for primitive memory references.

---
 src/compiler/rtlgen/opncod.scm | 27 ++++++++++++++++++++-------
 1 file changed, 20 insertions(+), 7 deletions(-)

diff --git a/src/compiler/rtlgen/opncod.scm b/src/compiler/rtlgen/opncod.scm
index 35ab015bc..686200207 100644
--- 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)))))
 
-(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)
-- 
2.25.1