From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 20 Apr 2017 00:44:44 +0000 (-0700)
Subject: Allow string operations to take Unicode strings with 1 byte per CP.
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~31
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=13e8c052ae09689b2e4991ffdb2e2b6b1e80e08e;p=mit-scheme.git

Allow string operations to take Unicode strings with 1 byte per CP.
---

diff --git a/src/microcode/object.h b/src/microcode/object.h
index bb5fc5714..9b5e02a28 100644
--- a/src/microcode/object.h
+++ b/src/microcode/object.h
@@ -177,6 +177,7 @@ extern SCHEME_OBJECT * memory_base;
 #define CHARACTER_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER)
 #define BYTEVECTOR_P(object) ((OBJECT_TYPE (object)) == TC_BYTEVECTOR)
 #define LEGACY_STRING_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER_STRING)
+#define UNICODE_STRING_P(object) ((OBJECT_TYPE (object)) == TC_UNICODE_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)
diff --git a/src/microcode/string.c b/src/microcode/string.c
index 0cc0d084f..22551e7b5 100644
--- a/src/microcode/string.c
+++ b/src/microcode/string.c
@@ -33,7 +33,15 @@ USA.
 bool
 string_p (SCHEME_OBJECT object)
 {
-  return ((LEGACY_STRING_P (object)) || (BYTEVECTOR_P (object)));
+  return ((LEGACY_STRING_P (object))
+          || (BYTEVECTOR_P (object))
+          || ((UNICODE_STRING_P (object))
+              // This tests that the ustring-cp-size is == 1, meaning
+              // one byte per code point.  This must be kept in sync
+              // with "runtime/ustring.scm".
+              && (((OBJECT_TYPE (MEMORY_REF (object, BYTEVECTOR_LENGTH_INDEX)))
+                   && 0x03)
+                  == 0x01)));
 }
 
 SCHEME_OBJECT