From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 5 Jan 2017 20:16:05 +0000 (-0800)
Subject: Add bytevector primitives to SF transformation rules.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~226
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=99c86296c13901e3149881e0fb7be5e37ac701d3;p=mit-scheme.git

Add bytevector primitives to SF transformation rules.
---

diff --git a/src/sf/gconst.scm b/src/sf/gconst.scm
index 1ab4cc148..01e2bf885 100644
--- a/src/sf/gconst.scm
+++ b/src/sf/gconst.scm
@@ -66,6 +66,10 @@ USA.
     (BIT-STRING? BIT-STRING?)
     (BIT-SUBSTRING-FIND-NEXT-SET-BIT BIT-SUBSTRING-FIND-NEXT-SET-BIT)
     (BIT-SUBSTRING-MOVE-RIGHT! BIT-SUBSTRING-MOVE-RIGHT!)
+    (BYTEVECTOR-LENGTH BYTEVECTOR-LENGTH)
+    (BYTEVECTOR-U8-REF BYTEVECTOR-U8-REF)
+    (BYTEVECTOR-U8-SET! BYTEVECTOR-U8-SET!)
+    (BYTEVECTOR? BYTEVECTOR?)
     (CAR CAR)
     (CDR CDR)
     (CELL-CONTENTS CELL-CONTENTS)
diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 94ec9c8bf..de17f87aa 100644
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -557,6 +557,13 @@ USA.
 			operands)
       #f))
 
+(define (make-bytevector-expansion expr operands block)
+  (if (and (pair? operands)
+	   (null? (cdr operands)))
+      (make-combination expr block (ucode-primitive allocate-bytevector 1)
+			operands)
+      #f))
+
 (define (not-expansion expr operands block)
   (if (and (pair? operands)
 	   (null? (cdr operands)))
@@ -749,6 +756,7 @@ USA.
 	    int:integer?
 	    intern
 	    list
+	    make-bytevector
 	    make-string
 	    make-vector-8b
 	    ;; modulo	; Compiler does not currently open-code it.
@@ -834,7 +842,7 @@ USA.
 	   exact-integer?-expansion
 	   intern-expansion
 	   list-expansion
-	   make-string-expansion
+	   make-bytevector-expansion
 	   make-string-expansion
 	   ;; modulo-expansion
 	   negative?-expansion