From 24ceffe34fc13205b5937ed33dcd9e90a92eabd1 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 11 Apr 2017 21:21:07 -0700 Subject: [PATCH] Allocate new type unicode-string. --- src/microcode/gcloop.c | 2 +- src/microcode/types.h | 6 +++--- src/runtime/host-adapter.scm | 7 +++++-- 3 files changed, 9 insertions(+), 6 deletions(-) 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)) -- 2.25.1