From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 12 Apr 2017 04:21:07 +0000 (-0700)
Subject: Allocate new type unicode-string.
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~56
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=24ceffe34fc13205b5937ed33dcd9e90a92eabd1;p=mit-scheme.git

Allocate new type unicode-string.
---

diff --git a/src/microcode/gcloop.c b/src/microcode/gcloop.c
index 4d50a606e..d28552a4f 100644
--- a/src/microcode/gcloop.c
+++ b/src/microcode/gcloop.c
@@ -1280,7 +1280,7 @@ gc_type_t gc_type_map [N_TYPE_CODES] =
   GC_NON_POINTER,		/* TC_PRIMITIVE */
   GC_PAIR,			/* TC_SEQUENCE */
   GC_NON_POINTER,		/* TC_FIXNUM */
-  GC_UNDEFINED,			/* was TC_PCOMB1 */
+  GC_VECTOR,			/* TC_UNICODE_STRING */
   GC_VECTOR,			/* TC_CONTROL_POINT */
   GC_PAIR,			/* TC_INTERNED_SYMBOL */
   GC_VECTOR,			/* TC_CHARACTER_STRING */
diff --git a/src/microcode/types.h b/src/microcode/types.h
index 451157be0..13d2edca8 100644
--- a/src/microcode/types.h
+++ b/src/microcode/types.h
@@ -26,7 +26,7 @@ USA.
 
 /* Type code definitions */
 
-#define TC_FALSE				0x00
+#define TC_FALSE			0x00
 #define TC_LIST				0x01
 #define TC_CHARACTER			0x02
 #define	TC_SCODE_QUOTE			0x03
@@ -53,7 +53,7 @@ USA.
 #define TC_PRIMITIVE			0x18
 #define TC_SEQUENCE			0x19
 #define TC_FIXNUM			0x1A
-/* #define TC_PCOMB1			0x1B */
+#define TC_UNICODE_STRING		0x1B
 #define TC_CONTROL_POINT		0x1C
 #define TC_INTERNED_SYMBOL		0x1D
 #define TC_CHARACTER_STRING		0x1E
@@ -131,7 +131,7 @@ USA.
   /* 0x18 */			"primitive",				\
   /* 0x19 */			"sequence",				\
   /* 0x1A */			"fixnum",				\
-  /* 0x1B */			0,					\
+  /* 0x1B */			"unicode-string",			\
   /* 0x1C */			"control-point",			\
   /* 0x1D */			"interned-symbol",			\
   /* 0x1e */			"string",				\
diff --git a/src/runtime/host-adapter.scm b/src/runtime/host-adapter.scm
index a77e5d93d..61b175784 100644
--- a/src/runtime/host-adapter.scm
+++ b/src/runtime/host-adapter.scm
@@ -51,6 +51,7 @@ USA.
 	    (or (microcode-type/name->code name)
 		(cond ((eq? name 'bytevector) #x33)
 		      ((eq? name 'tagged-object) #x25)
+		      ((eq? name 'unicode-string) #x1B)
 		      (else #t))
 		(error "MICROCODE-TYPE: Unknown name" name))))
        (->environment '()))
@@ -75,13 +76,15 @@ USA.
 		       (else #f))))
 	  (define (create-links-from-description description)
 	    (let ((environment
-		   (find-package-environment (package-description/name description))))
+		   (find-package-environment
+		    (package-description/name description))))
 	      (let ((bindings (package-description/exports description)))
 		(let ((n (vector-length bindings)))
 		  (do ((i 0 (fix:+ i 1)))
 		      ((fix:= i n))
 		    (let ((binding (vector-ref bindings i)))
-		      (link-variables (find-package-environment (vector-ref binding 1))
+		      (link-variables (find-package-environment
+				       (vector-ref binding 1))
 				      (if (fix:= (vector-length binding) 3)
 					  (vector-ref binding 2)
 					  (vector-ref binding 0))