From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 8 Jan 2017 22:08:13 +0000 (-0800)
Subject: Generalize string primitives to accept bytevectors where that makes sense.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~172
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=65b18d0067d01bde3dc630e8082d8d07c2d019b3;p=mit-scheme.git

Generalize string primitives to accept bytevectors where that makes sense.

This will be used to support more general strings in the runtime system.
---

diff --git a/src/microcode/debug.c b/src/microcode/debug.c
index 00b070ab7..560e5d87b 100644
--- a/src/microcode/debug.c
+++ b/src/microcode/debug.c
@@ -380,6 +380,7 @@ do_printing (outf_channel stream, SCHEME_OBJECT Expr, bool Detailed)
       goto SPrint;
 
     case TC_CHARACTER_STRING:
+    case TC_BYTEVECTOR:
       print_string (stream, Expr);
       return;
 
diff --git a/src/microcode/object.h b/src/microcode/object.h
index 5c0c22a10..edfe3c7ef 100644
--- a/src/microcode/object.h
+++ b/src/microcode/object.h
@@ -176,7 +176,7 @@ extern SCHEME_OBJECT * memory_base;
 #define COMPLEX_P(object) ((OBJECT_TYPE (object)) == TC_COMPLEX)
 #define CHARACTER_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER)
 #define BYTEVECTOR_P(object) ((OBJECT_TYPE (object)) == TC_BYTEVECTOR)
-#define STRING_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER_STRING)
+#define LEGACY_STRING_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER_STRING)
 #define BIT_STRING_P(object) ((OBJECT_TYPE (object)) == TC_BIT_STRING)
 #define CELL_P(object) ((OBJECT_TYPE (object)) == TC_CELL)
 #define PAIR_P(object) ((OBJECT_TYPE (object)) == TC_LIST)
@@ -193,6 +193,9 @@ extern SCHEME_OBJECT * memory_base;
 #define RETURN_CODE_P(object) ((OBJECT_TYPE (object)) == TC_RETURN_CODE)
 #define EPHEMERON_P(object) ((OBJECT_TYPE (object)) == TC_EPHEMERON)
 
+#define STRING_P(object)                                                \
+  ((BYTEVECTOR_P (object)) || (LEGACY_STRING_P (object)))
+
 #define NON_MARKED_VECTOR_P(object)					\
   ((OBJECT_TYPE (object)) == TC_NON_MARKED_VECTOR)
 
diff --git a/src/microcode/string.c b/src/microcode/string.c
index 036c76513..3f1319d9e 100644
--- a/src/microcode/string.c
+++ b/src/microcode/string.c
@@ -105,7 +105,7 @@ DEFINE_PRIMITIVE ("STRING-ALLOCATE", Prim_string_allocate, 1, 1, 0)
 DEFINE_PRIMITIVE ("STRING?", Prim_string_p, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);
-  PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (STRING_P (ARG_REF (1))));
+  PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (LEGACY_STRING_P (ARG_REF (1))));
 }
 
 DEFINE_PRIMITIVE ("STRING-LENGTH", Prim_string_length, 1, 1, 0)
@@ -118,7 +118,7 @@ DEFINE_PRIMITIVE ("STRING-LENGTH", Prim_string_length, 1, 1, 0)
 DEFINE_PRIMITIVE ("STRING-MAXIMUM-LENGTH", Prim_string_maximum_length, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);
-  CHECK_ARG (1, STRING_P);
+  CHECK_ARG (1, LEGACY_STRING_P);
   PRIMITIVE_RETURN
     (LONG_TO_UNSIGNED_FIXNUM (MAXIMUM_STRING_LENGTH (ARG_REF (1))));
 }
@@ -126,7 +126,7 @@ DEFINE_PRIMITIVE ("STRING-MAXIMUM-LENGTH", Prim_string_maximum_length, 1, 1, 0)
 DEFINE_PRIMITIVE ("SET-STRING-LENGTH!", Prim_set_string_length, 2, 2, 0)
 {
   PRIMITIVE_HEADER (2);
-  CHECK_ARG (1, STRING_P);
+  CHECK_ARG (1, LEGACY_STRING_P);
   {
     SCHEME_OBJECT string = (ARG_REF (1));
     SET_STRING_LENGTH
@@ -139,7 +139,7 @@ DEFINE_PRIMITIVE ("SET-STRING-LENGTH!", Prim_set_string_length, 2, 2, 0)
 DEFINE_PRIMITIVE ("SET-STRING-MAXIMUM-LENGTH!", Prim_set_string_maximum_length, 2, 2, 0)
 {
   PRIMITIVE_HEADER (2);
-  CHECK_ARG (1, STRING_P);
+  CHECK_ARG (1, LEGACY_STRING_P);
   {
     SCHEME_OBJECT string = (ARG_REF (1));
     long length