From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 8 Jan 2019 05:38:38 +0000 (+0000)
Subject: Teach stackify about bytevectors.
X-Git-Tag: mit-scheme-pucked-10.1.10~6^2~71
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4ca7d6277e6907ea5c2a9c67884a415bd08a7162;p=mit-scheme.git

Teach stackify about bytevectors.

XXX Really it should use bytevectors as the basic type now, and we
should teach it about strings, but this is more expedient since it
was written when string == bytevector and mostly this works out.
---

diff --git a/src/compiler/machines/C/stackify.scm b/src/compiler/machines/C/stackify.scm
index 0f1a7dcca..900b07cb3 100644
--- a/src/compiler/machines/C/stackify.scm
+++ b/src/compiler/machines/C/stackify.scm
@@ -133,6 +133,7 @@ USA.
       (flo:flonum? obj)
       (symbol? obj)
       (string? obj)
+      (bytevector? obj)
       (bit-string? obj)
       (scode/primitive-procedure? obj)
       ;; The runtime system needs the following
@@ -509,6 +510,15 @@ USA.
 			   (bit-string->unsigned-integer obj)
 			   16))))
 		       (build/push-nat (bit-string-length obj) prog)))
+	((bytevector? obj)
+	 (build/string stackify-opcode/push-bytevector
+		       (let ((string
+			      (make-vector-8b (bytevector-length obj))))
+			 (do ((i 0 (+ i 1)))
+			     ((>= i (bytevector-length obj)))
+			   (vector-8b-set! string i (bytevector-u8-ref obj i)))
+			 string)
+		       prog))
 	((scode/primitive-procedure? obj)
 	 (let ((arity (primitive-procedure-arity obj))
 	       (name (symbol->string (primitive-procedure-name obj))))
diff --git a/src/compiler/machines/C/stackops.scm b/src/compiler/machines/C/stackops.scm
index b2646a46e..1fdc5a002 100644
--- a/src/compiler/machines/C/stackops.scm
+++ b/src/compiler/machines/C/stackops.scm
@@ -243,6 +243,8 @@ push-primitive-5			; name in string table
 push-primitive-6			; name in string table
 push-primitive-7			; name in string table
 ;; 8
+
+push-bytevector				; in string table
 )
 
 (define stackify/fast-fixnum-opcodes
diff --git a/src/microcode/liarc.h b/src/microcode/liarc.h
index d3a533144..e9cd7cd22 100644
--- a/src/microcode/liarc.h
+++ b/src/microcode/liarc.h
@@ -80,6 +80,9 @@ typedef unsigned long entry_count_t;
 #define C_STRING_TO_SCHEME_STRING(len, str)				\
   (MEMORY_TO_STRING ((len), ((const uint8_t *) (str))))
 
+#define C_STRING_TO_SCHEME_BYTEVECTOR(len, str)				\
+  (MEMORY_TO_BYTEVECTOR ((len), ((const uint8_t *) (str))))
+
 #define C_SYM_INTERN(len, str)						\
   (MEMORY_TO_SYMBOL ((len), ((const uint8_t *) (str))))
 
@@ -440,6 +443,7 @@ extern int multiply_with_overflow (long, long, long *);
 #define MAKE_PRIMITIVE(str, arity)					\
   (make_primitive (((const char *) (str)), ((int) (arity))))
 
+#define MEMORY_TO_BYTEVECTOR memory_to_bytevector
 #define MEMORY_TO_STRING memory_to_string
 #define MEMORY_TO_SYMBOL memory_to_symbol
 #define MAKE_VECTOR make_vector
diff --git a/src/microcode/stackops.h b/src/microcode/stackops.h
index 6c24cf124..fc3998f2b 100644
--- a/src/microcode/stackops.h
+++ b/src/microcode/stackops.h
@@ -149,7 +149,8 @@ typedef enum
   stackify_opcode_push_primitive_5 = 0305,
   stackify_opcode_push_primitive_6 = 0306,
   stackify_opcode_push_primitive_7 = 0307,
-  N_STACKIFY_OPCODE = 0310
+  stackify_opcode_push_bytevector = 0310,
+  N_STACKIFY_OPCODE = 0311
 } stackify_opcode_t;
 
 #endif /* !STACKOPS_H */
diff --git a/src/microcode/unstackify.c b/src/microcode/unstackify.c
index d4266e7c0..3c58e0fb5 100644
--- a/src/microcode/unstackify.c
+++ b/src/microcode/unstackify.c
@@ -265,7 +265,7 @@ static const char * opcode_names [] =
   "stackify-opcode/push-primitive-5",
   "stackify-opcode/push-primitive-6",
   "stackify-opcode/push-primitive-7",
-  "unknown-0310",
+  "stackify-opcode/push-bytevector",
   "unknown-0311",
   "unknown-0312",
   "unknown-0313",
@@ -613,6 +613,14 @@ stackify_push_string (stackify_opcode_t op)
   unstackify_push (C_STRING_TO_SCHEME_STRING (len, str));
 }
 
+static void
+stackify_push_bytevector (stackify_opcode_t op)
+{
+  unsigned long len;
+  char * str = (unstackify_read_string (&len));
+  unstackify_push (C_STRING_TO_SCHEME_BYTEVECTOR (len, str));
+}
+
 static void
 stackify_push_symbol (stackify_opcode_t op)
 {
@@ -1017,6 +1025,10 @@ unstackify (unsigned char * bytes, size_t n_bytes, entry_count_t db)
 	  stackify_push_string (op);
 	  break;
 
+	case stackify_opcode_push_bytevector:
+	  stackify_push_bytevector (op);
+	  break;
+
 	case stackify_opcode_push_symbol:
 	  stackify_push_symbol (op);
 	  break;