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 0f1a7dccafa9f8e44bf4209d4f5dbc4491e6d8e2..900b07cb3dd23c7a829f53021e7f11b20a52720c 100644 (file)
--- 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 b2646a46eb9b8c6cb7dbb62206384a486b0b2a06..1fdc5a002d5bbcfdf25fde5792fba07112131868 100644 (file)
--- 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
 )
 \f
 (define stackify/fast-fixnum-opcodes

diff --git a/src/microcode/liarc.h b/src/microcode/liarc.h
index d3a5331444320e3d6b3a68ec535bb757c8462b45..e9cd7cd22dec5828a66cf1b998157fbd5e1ba8d3 100644 (file)
--- 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 6c24cf1240dd1e9a093f43d578aa6ea2fe865e82..fc3998f2bf3e8a674bd34c8a9a23d7d1910c41ce 100644 (file)
--- 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 d4266e7c025b7436c1c6d5345cbcc5201d21371f..3c58e0fb547190507e214af2f66fb2e5a7894282 100644 (file)
--- 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;