FFI now supports Unicode (UTF16) strings better, and the Cocoa bridge uses this functionality

TODO.FACTOR.txt

@@ -1,5 +1,3 @@
-- core foundation should use unicode strings
-- alien>utf16-string, utf16-string>alien words
 - fix compiled gc check
 - 3 >n fep
 - code walker & exceptions -- test and debug problems

doc/handbook/alien.facts

@@ -122,8 +122,8 @@ $terpri
 "Passing a Factor string to a C function expecting a C string allocates a byte array in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function. The function must not retain such pointers after it returns, since byte arrays in the Factor heap can be moved by the garbage collector. To allocate a string which will not move, use " { $link <malloc-string> } " and then " { $link free } "."
 $terpri
 "A couple of words can be used to read and write " { $snippet "char*" } " strings from arbitrary addresses:"
-{ $subsection alien>string }
-{ $subsection string>alien } ;
+{ $subsection alien>char-string }
+{ $subsection string>char-alien } ;
 
 ARTICLE: "c-structs" "C structure types"
 "A " { $snippet "struct" } " in C is essentially a block of memory with the value of each structure field stored at a fixed offset. The C library interface provides some utilities to define words which read and write structure fields given a base address."
@@ -252,7 +252,7 @@ $terpri
 ARTICLE: "malloc" "Manual memory management"
 "Sometimes data passed to C functions must be allocated at a fixed address so that C code can safely store pointers."
 $terpri
-"The following words mirror " { $link <c-object> } ", " { $link <c-array> } " and " { $link string>alien } ":"
+"The following words mirror " { $link <c-object> } ", " { $link <c-array> } " and " { $link string>char-alien } ":"
 { $subsection <malloc-object> }
 { $subsection <malloc-array> }
 { $subsection <malloc-string> }

library/bootstrap/primitives.factor

@@ -191,8 +191,10 @@ call
     { "set-alien-float" "alien"             }
     { "alien-double" "alien"                }
     { "set-alien-double" "alien"            }
-    { "alien>string" "alien"                }
-    { "string>alien" "alien"                }
+    { "alien>char-string" "alien"           }
+    { "string>char-alien" "alien"           }
+    { "alien>u16-string" "alien"            }
+    { "string>u16-alien" "alien"            }
     { "throw" "errors"                      }
     { "string>memory" "kernel-internals"    }
     { "memory>string" "kernel-internals"    }

library/cocoa/core-foundation.factor

@@ -16,20 +16,17 @@ FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;
 ! Core Foundation utilities -- will be moved elsewhere
 : kCFURLPOSIXPathStyle 0 ;
 
-: kCFStringEncodingMacRoman HEX: 0 ;
-: kCFStringEncodingUnicode HEX: 100 ;
-
 FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ;
 
 FUNCTION: void* CFURLCreateWithString ( void* allocator, void* string, void* base ) ;
 
 FUNCTION: void* CFURLCopyFileSystemPath ( void* url, int pathStyle ) ;
 
-FUNCTION: void* CFStringCreateWithCString ( void* allocator, char* cStr, int encoding ) ;
+FUNCTION: void* CFStringCreateWithCharacters ( void* allocator, ushort* cStr, CFIndex numChars ) ;
 
 FUNCTION: CFIndex CFStringGetLength ( void* theString ) ;
 
-FUNCTION: bool CFStringGetCString ( void* theString, void* buffer, CFIndex bufferSize, int encoding ) ;
+FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
 
 FUNCTION: CFIndex CFStringGetLength ( void* string ) ;
 
@@ -40,12 +37,12 @@ FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
 FUNCTION: void CFRelease ( void* cf ) ;
 
 : <CFString> ( string -- cf )
-    f swap kCFStringEncodingMacRoman CFStringCreateWithCString ;
+    f swap dup length CFStringCreateWithCharacters ;
 
 : CF>string ( string -- string )
-    dup CFStringGetLength 1+ dup <byte-array> [
-        swap kCFStringEncodingMacRoman CFStringGetCString drop
-    ] keep alien>string ;
+    dup CFStringGetLength 1+ "ushort" <c-array> [
+        >r 0 over CFStringGetLength r> CFStringGetCharacters
+    ] keep alien>u16-string ;
 
 : <CFFileSystemURL> ( string dir? -- cf )
     >r <CFString> f over kCFURLPOSIXPathStyle

library/compiler/alien/c-types.facts

@@ -42,16 +42,16 @@ HELP: <c-object> "( n type -- array )"
 { $errors "Throws an error if the type does not exist." }
 { $see-also <malloc-object> } ;
 
-HELP: string>alien "( string -- array )"
+HELP: string>char-alien "( string -- array )"
 { $values { "string" "a string" } { "array" "a byte array" } }
 { $description "Copies the string to a new byte array, converting it to 8-bit ASCII and adding a trailing null byte." }
 { $errors "Throws an error if the string contains null characters, or characters beyond the 8-bit range." } 
-{ $see-also alien>string <malloc-string> } ;
+{ $see-also alien>char-string <malloc-string> } ;
 
-HELP: alien>string "( c-ptr -- string )"
+HELP: alien>char-string "( c-ptr -- string )"
 { $values { "c-ptr" "an alien, byte array or " { $link f } } { "string" "a string" } }
 { $description "Reads a null-terminated 8-bit C string from the specified address." }
-{ $see-also string>alien } ;
+{ $see-also string>char-alien } ;
 
 HELP: <malloc-array> "( n type -- alien )"
 { $values { "n" "a non-negative integer" } { "type" "a string" } { "alien" "an alien address" } }
@@ -72,7 +72,7 @@ HELP: <malloc-string> "( string -- alien )"
 { $description "Copies a string to an unmanaged memory block large enough to hold a copy of the string in 8-bit ASCII encoding, with a trailing null byte." }
 { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
 { $errors "Throws an error if memory allocation fails." }
-{ $see-also string>alien } ;
+{ $see-also string>char-alien } ;
 
 HELP: (typedef) "( old new -- )"
 { $values { "old" "a string" } { "new" "a string" } }

library/compiler/alien/primitive-types.factor

@@ -102,21 +102,21 @@ USING: alien compiler kernel kernel-internals math namespaces ;
 ] "uchar" define-primitive-type
 
 [
-    [ alien-unsigned-cell <alien> alien>string ] "getter" set
+    [ alien-unsigned-cell <alien> alien>char-string ] "getter" set
     [ >r >r alien-address r> r> set-alien-unsigned-cell ] "setter" set
     bootstrap-cell "width" set
     bootstrap-cell "align" set
-    "box_c_string" "boxer-function" set
-    "unbox_c_string" "unboxer-function" set
+    "box_char_string" "boxer-function" set
+    "unbox_char_string" "unboxer-function" set
 ] "char*" (define-primitive-type)
 
 [
-    [ alien-unsigned-4 ] "getter" set
-    [ >r >r alien-address r> r> set-alien-unsigned-4 ] "setter" set
+    [ alien-unsigned-cell <alien> alien>u16-string ] "getter" set
+    [ >r >r alien-address r> r> set-alien-unsigned-cell ] "setter" set
     4 "width" set
     4 "align" set
-    "box_utf16_string" "boxer-function" set
-    "unbox_utf16_string" "unboxer-function" set
+    "box_u16_string" "boxer-function" set
+    "unbox_u16_string" "unboxer-function" set
 ] "ushort*" (define-primitive-type)
 
 [

library/compiler/inference/known-words.factor

@@ -436,11 +436,17 @@ sequences strings vectors words prettyprint ;
 \ alien-double [ [ c-ptr integer ] [ float ] ] "infer-effect" set-word-prop
 \ alien-double t "flushable" set-word-prop
 
-\ alien>string [ [ c-ptr ] [ string ] ] "infer-effect" set-word-prop
-\ alien>string t "flushable" set-word-prop
+\ alien>char-string [ [ c-ptr ] [ string ] ] "infer-effect" set-word-prop
+\ alien>char-string t "flushable" set-word-prop
 
-\ string>alien [ [ string ] [ byte-array ] ] "infer-effect" set-word-prop
-\ string>alien t "flushable" set-word-prop
+\ string>char-alien [ [ string ] [ byte-array ] ] "infer-effect" set-word-prop
+\ string>char-alien t "flushable" set-word-prop
+
+\ alien>u16-string [ [ c-ptr ] [ string ] ] "infer-effect" set-word-prop
+\ alien>u16-string t "flushable" set-word-prop
+
+\ string>u16-alien [ [ string ] [ byte-array ] ] "infer-effect" set-word-prop
+\ string>u16-alien t "flushable" set-word-prop
 
 \ string>memory [ [ string integer ] [ ] ] "infer-effect" set-word-prop
 \ memory>string [ [ integer integer ] [ string ] ] "infer-effect" set-word-prop

library/test/alien.factor

@@ -49,7 +49,16 @@ cell 8 = [
     ] unit-test
 ] when
 
+[ "\u00ff" ]
+[ "\u00ff" string>char-alien alien>char-string ]
+unit-test
+
 [ "hello world" ]
-[ "hello world" string>alien alien>string ] unit-test
+[ "hello world" string>char-alien alien>char-string ]
+unit-test
+
+[ "hello\uabcdworld" ]
+[ "hello\uabcdworld" string>u16-alien alien>u16-string ]
+unit-test
 
 [ t ] [ f expired? ] unit-test

library/windows/clipboard.factor

@@ -17,7 +17,7 @@ IN: win32
             dup GlobalLock swap
             GlobalUnlock drop
     ] if
-    CloseClipboard drop alien>string ;
+    CloseClipboard drop alien>char-string ;
 
 LIBRARY: libc
 FUNCTION: void memcpy ( char* dst, char* src, ulong size ) ;

native/alien.c

@@ -92,24 +92,6 @@ void primitive_alien_address(void)
 	box_unsigned_cell((CELL)alien_offset(dpop()));
 }
 
-/* convert C string at address to Factor string */
-void primitive_alien_to_string(void)
-{
-	maybe_gc(0);
-	drepl(tag_object(from_c_string(alien_offset(dpeek()))));
-}
-
-/* convert Factor string to C string allocated in the Factor heap */
-void primitive_string_to_alien(void)
-{
-	CELL string, type;
-	maybe_gc(0);
-	string = dpeek();
-	type = type_of(string);
-	if(type != ALIEN_TYPE && type != BYTE_ARRAY_TYPE && type != F_TYPE)
-		drepl(tag_object(string_to_alien(untag_string(string),true)));
-}
-
 /* image loading */
 void fixup_alien(ALIEN *d)
 {
@@ -144,8 +126,8 @@ DEF_ALIEN_SLOT(signed_4,s32,signed_4)
 DEF_ALIEN_SLOT(unsigned_4,u32,unsigned_4)
 DEF_ALIEN_SLOT(signed_2,s16,signed_2)
 DEF_ALIEN_SLOT(unsigned_2,u16,unsigned_2)
-DEF_ALIEN_SLOT(signed_1,BYTE,signed_1)
-DEF_ALIEN_SLOT(unsigned_1,BYTE,unsigned_1)
+DEF_ALIEN_SLOT(signed_1,u8,signed_1)
+DEF_ALIEN_SLOT(unsigned_1,u8,unsigned_1)
 DEF_ALIEN_SLOT(float,float,float)
 DEF_ALIEN_SLOT(double,double,double)
 

native/alien.h

@@ -18,9 +18,6 @@ void primitive_alien_address(void);
 
 void* alien_offset(CELL object);
 
-void primitive_alien_to_string(void);
-void primitive_string_to_alien(void);
-
 void fixup_alien(ALIEN* d);
 void collect_alien(ALIEN* d);
 

native/debug.c

@@ -3,7 +3,7 @@
 void print_word(F_WORD* word)
 {
 	if(type_of(word->name) == STRING_TYPE)
-		fprintf(stderr,"%s",to_c_string(untag_string(word->name),true));
+		fprintf(stderr,"%s",to_char_string(untag_string(word->name),true));
 	else
 	{
 		fprintf(stderr,"#<not a string: ");
@@ -16,7 +16,7 @@ void print_word(F_WORD* word)
 
 void print_string(F_STRING* str)
 {
-	fprintf(stderr,"\"%s\"",to_c_string(str,true));
+	fprintf(stderr,"\"%s\"",to_char_string(str,true));
 }
 
 void print_array(F_ARRAY* array)

native/factor.c

@@ -17,11 +17,11 @@ void init_factor(const char* image,
 	call(userenv[BOOT_ENV]);
 	init_c_io();
 	init_signals();
-	userenv[CPU_ENV] = tag_object(from_c_string(FACTOR_CPU_STRING));
-	userenv[OS_ENV] = tag_object(from_c_string(FACTOR_OS_STRING));
+	userenv[CPU_ENV] = tag_object(from_char_string(FACTOR_CPU_STRING));
+	userenv[OS_ENV] = tag_object(from_char_string(FACTOR_OS_STRING));
 	userenv[GEN_ENV] = tag_fixnum(gen_count);
 	userenv[CARD_OFF_ENV] = tag_cell(cards_offset);
-	userenv[IMAGE_ENV] = tag_object(from_c_string(image));
+	userenv[IMAGE_ENV] = tag_object(from_char_string(image));
 	userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
 	userenv[COMPILED_BASE_ENV] = tag_cell(compiling.base);
 }
@@ -113,7 +113,7 @@ int main(int argc, char** argv)
 	args = array(ARRAY_TYPE,argc,F);
 	while(arg_count < argc)
 	{
-		put(AREF(args,arg_count),tag_object(from_c_string(argv[arg_count])));
+		put(AREF(args,arg_count),tag_object(from_char_string(argv[arg_count])));
 		arg_count++;
 	}
 

native/factor.h

@@ -32,9 +32,6 @@ typedef signed short s16;
 typedef signed int s32;
 typedef signed long long s64;
 
-/* must always be 8 bits */
-typedef unsigned char BYTE;
-
 CELL cs;
 
 #if defined(FACTOR_X86)

native/float.c

@@ -40,7 +40,7 @@ void primitive_str_to_float(void)
 	maybe_gc(sizeof(F_FLOAT));
 
 	str = untag_string(dpeek());
-	c_str = to_c_string(str,true);
+	c_str = to_char_string(str,true);
 	end = c_str;
 	f = strtod(c_str,&end);
 	if(end != c_str + string_capacity(str))
@@ -56,7 +56,7 @@ void primitive_float_to_str(void)
 
 	snprintf(tmp,32,"%.16g",to_float(dpop()));
 	tmp[32] = '\0';
-	box_c_string(tmp);
+	box_char_string(tmp);
 }
 
 #define GC_AND_POP_FLOATS(x,y) \

native/image.c

@@ -138,5 +138,5 @@ void primitive_save_image(void)
 	/* do a full GC to push everything into tenured space */
 	garbage_collection(TENURED);
 	filename = untag_string(dpop());
-	save_image(to_c_string(filename,true));
+	save_image(to_char_string(filename,true));
 }

native/io.c

@@ -26,7 +26,7 @@ void init_c_io(void)
 
 void io_error(void)
 {
-	CELL error = tag_object(from_c_string(strerror(errno)));
+	CELL error = tag_object(from_char_string(strerror(errno)));
 	general_error(ERROR_IO,error,F,true);
 }
 
@@ -35,8 +35,8 @@ void primitive_fopen(void)
 	char *path, *mode;
 	FILE* file;
 	maybe_gc(0);
-	mode = pop_c_string();
-	path = pop_c_string();
+	mode = pop_char_string();
+	path = pop_char_string();
 	file = fopen(path,mode);
 	if(file == NULL)
 		io_error();
@@ -64,7 +64,7 @@ void primitive_fwrite(void)
 	if(string_capacity(text) == 0)
 		return;
 
-	if(fwrite(to_c_string(text,false),1,
+	if(fwrite(to_char_string(text,false),1,
 		untag_fixnum_fast(text->length),
 		file) == 0)
 		io_error();

native/memory.h

@@ -30,16 +30,6 @@ INLINE void cput(CELL where, u16 what)
 	*((u16*)where) = what;
 }
 
-INLINE BYTE bget(CELL where)
-{
-	return *((BYTE*)where);
-}
-
-INLINE void bput(CELL where, BYTE what)
-{
-	*((BYTE*)where) = what;
-}
-
 INLINE CELL align8(CELL a)
 {
 	return (a + 7) & ~7;

native/misc.c

@@ -19,12 +19,12 @@ void primitive_os_env(void)
 
 	maybe_gc(0);
 
-	name = pop_c_string();
+	name = pop_char_string();
 	value = getenv(name);
 	if(value == NULL)
 		dpush(F);
 	else
-		box_c_string(getenv(name));
+		box_char_string(getenv(name));
 }
 
 void primitive_eq(void)
@@ -61,7 +61,7 @@ char *buffer_to_c_string(char *buffer)
 {
 	int capacity = strlen(buffer);
 	F_STRING *_c_str = allot_string(capacity / CHARS + 1);
-	BYTE *c_str = (BYTE*)(_c_str + 1);
+	u8 *c_str = (u8*)(_c_str + 1);
 	strcpy(c_str, buffer);
 	LocalFree(buffer);
 	return (char*)c_str;

native/primitives.c

@@ -155,11 +155,13 @@ void* primitives[] = {
 	primitive_set_alien_float,
 	primitive_alien_double,
 	primitive_set_alien_double,
-	primitive_alien_to_string,
-	primitive_string_to_alien,
+	primitive_alien_to_char_string,
+	primitive_string_to_char_alien,
+	primitive_alien_to_u16_string,
+	primitive_string_to_u16_alien,
 	primitive_throw,
-	primitive_string_to_memory,
-	primitive_memory_to_string,
+	primitive_char_string_to_memory,
+	primitive_memory_to_char_string,
 	primitive_alien_address,
 	primitive_slot,
 	primitive_set_slot,

native/string.c

@@ -86,144 +86,123 @@ void primitive_resize_string(void)
 	drepl(tag_object(resize_string(string,capacity,F)));
 }
 
-F_STRING *memory_to_string(const BYTE* string, CELL length)
-{
-	F_STRING* s = allot_string(length);
-	CELL i;
+/* Some ugly macros to prevent a 2x code duplication */
 
-	for(i = 0; i < length; i++)
-	{
-		cput(SREF(s,i),*string);
-		string++;
+#define MEMORY_TO_STRING(type,utype) \
+	F_STRING *memory_to_##type##_string(const type *string, CELL length) \
+	{ \
+		F_STRING* s = allot_string(length); \
+		CELL i; \
+		for(i = 0; i < length; i++) \
+		{ \
+			cput(SREF(s,i),(utype)*string); \
+			string++; \
+		} \
+		rehash_string(s); \
+		return s; \
+	} \
+	void primitive_memory_to_##type##_string(void) \
+	{ \
+		CELL length = unbox_unsigned_cell(); \
+		type *string = (type*)unbox_unsigned_cell(); \
+		dpush(tag_object(memory_to_##type##_string(string,length))); \
+	} \
+	F_STRING *from_##type##_string(const type *str) \
+	{ \
+		CELL length = 0; \
+		type *scan = str; \
+		while(*scan++) length++; \
+		return memory_to_##type##_string((type*)str,length); \
+	} \
+	void box_##type##_string(const type *str) \
+	{ \
+		dpush(str ? tag_object(from_##type##_string(str)) : F); \
+	} \
+	void primitive_alien_to_##type##_string(void) \
+	{ \
+		maybe_gc(0); \
+		drepl(tag_object(from_##type##_string(alien_offset(dpeek())))); \
 	}
 
-	rehash_string(s);
-	
-	return s;
-}
+MEMORY_TO_STRING(char,u8)
+MEMORY_TO_STRING(u16,u16)
 
-void primitive_memory_to_string(void)
-{
-	CELL length = unbox_unsigned_cell();
-	BYTE *string = (BYTE*)unbox_unsigned_cell();
-	dpush(tag_object(memory_to_string(string,length)));
-}
-
-/* untagged */
-F_STRING *from_c_string(const char *c_string)
-{
-	return memory_to_string((BYTE*)c_string,strlen(c_string));
-}
-
-/* FFI calls this */
-void box_c_string(const char *c_string)
-{
-	dpush(c_string ? tag_object(from_c_string(c_string)) : F);
-}
-
-F_ARRAY *string_to_alien(F_STRING *s, bool check)
+void check_string(F_STRING *s, CELL max)
 {
 	CELL capacity = string_capacity(s);
-	F_ARRAY *_c_str;
-	
-	if(check)
-	{
-		CELL i;
-		for(i = 0; i < capacity; i++)
-		{
-			u16 ch = string_nth(s,i);
-			if(ch == '\0' || ch > 255)
-				general_error(ERROR_C_STRING,tag_object(s),F,true);
-		}
-	}
-
-	_c_str = allot_array(BYTE_ARRAY_TYPE,capacity / CELLS + 1);
-	BYTE *c_str = (BYTE*)(_c_str + 1);
-	string_to_memory(s,c_str);
-	c_str[capacity] = '\0';
-	return _c_str;
-}
-
-/* untagged */
-char *to_c_string(F_STRING *s, bool check)
-{
-	return (char*)(string_to_alien(s,check) + 1);
-}
-
-void string_to_memory(F_STRING *s, BYTE *string)
-{
 	CELL i;
-	CELL capacity = string_capacity(s);
 	for(i = 0; i < capacity; i++)
-		string[i] = string_nth(s,i);
-}
-
-void primitive_string_to_memory(void)
-{
-	BYTE *address = (BYTE*)unbox_unsigned_cell();
-	F_STRING *str = untag_string(dpop());
-	string_to_memory(str,address);
-}
-
-/* FFI calls this */
-char *unbox_c_string(void)
-{
-	CELL str = dpop();
-	if(type_of(str) == STRING_TYPE)
-		return to_c_string(untag_string(str),true);
-	else
-		return (char*)alien_offset(str);
-}
-
-/* this function is used when we really want only Factor strings as input, not
-aliens. In particular, certian primitives crash if given a null pointer (f), so
-we protect against this by using this function instead of unbox_c_string() */
-char *pop_c_string(void)
-{
-	return to_c_string(untag_string(dpop()),true);
-}
-
-/* FFI calls this */
-u16 *unbox_utf16_string(void)
-{
-	/* Return pointer to first character */
-	CELL obj = dpop();
-
-	if(type_of(obj) == STRING_TYPE)
 	{
-		F_STRING* str = untag_string(obj);
-		u16 *unboxed = (u16*)(str + 1);
-
-		CELL length = string_capacity(str);
-		CELL i;
-
-		for(i = 0; i < length; i++)
-		{
-			if(unboxed[i] == 0)
-				general_error(ERROR_C_STRING,obj,F,true);
-		}
-
-		return unboxed;
+		u16 ch = string_nth(s,i);
+		if(ch == '\0' || ch >= (1 << (max * 8)))
+			general_error(ERROR_C_STRING,tag_object(s),F,true);
 	}
-	else
-		return (u16*)alien_offset(obj);
 }
 
-/* FFI calls this */
-void box_utf16_string(u16 *unboxed)
+F_ARRAY *allot_c_string(CELL capacity, CELL size)
 {
-	CELL length = 0;
-	u16 *scan = unboxed;
-	F_STRING *str;
-
-	while(*scan++) length++;
-
-	str = allot_string(length);
-	memcpy((u16*)(str + 1),unboxed,length * sizeof(u16));
-	rehash_string(str);
-	dpush(tag_object(str));
+	return allot_array(BYTE_ARRAY_TYPE,capacity * size / CELLS + 1);
 }
 
+#define STRING_TO_MEMORY(type) \
+	void type##_string_to_memory(F_STRING *s, type *string) \
+	{ \
+		CELL i; \
+		CELL capacity = string_capacity(s); \
+		for(i = 0; i < capacity; i++) \
+			string[i] = string_nth(s,i); \
+	} \
+	void primitive_##type##_string_to_memory(void) \
+	{ \
+		type *address = (type*)unbox_unsigned_cell(); \
+		F_STRING *str = untag_string(dpop()); \
+		type##_string_to_memory(str,address); \
+	} \
+	F_ARRAY *string_to_##type##_alien(F_STRING *s, bool check) \
+	{ \
+		CELL capacity = string_capacity(s); \
+		F_ARRAY *_c_str; \
+		if(check) check_string(s,sizeof(type)); \
+		_c_str = allot_c_string(capacity,sizeof(type)); \
+		type *c_str = (type*)(_c_str + 1); \
+		type##_string_to_memory(s,c_str); \
+		c_str[capacity] = 0; \
+		return _c_str; \
+	} \
+	type *to_##type##_string(F_STRING *s, bool check) \
+	{ \
+		if(sizeof(type) == sizeof(u16)) \
+		{ \
+			if(check) check_string(s,sizeof(type)); \
+			return (type*)(s + 1); \
+		} \
+		else \
+			return (type*)(string_to_##type##_alien(s,check) + 1); \
+	} \
+	type *pop_##type##_string(void) \
+	{ \
+		return to_##type##_string(untag_string(dpop()),true); \
+	} \
+	type *unbox_##type##_string(void) \
+	{ \
+		if(type_of(dpeek()) == STRING_TYPE) \
+			return pop_##type##_string(); \
+		else \
+			return unbox_alien(); \
+	} \
+	void primitive_string_to_##type##_alien(void) \
+	{ \
+		CELL string, t; \
+		maybe_gc(0); \
+		string = dpeek(); \
+		t = type_of(string); \
+		if(t != ALIEN_TYPE && t != BYTE_ARRAY_TYPE && t != F_TYPE) \
+			drepl(tag_object(string_to_##type##_alien(untag_string(string),true))); \
+	}
+
+STRING_TO_MEMORY(char);
+STRING_TO_MEMORY(u16);
+
 void primitive_char_slot(void)
 {
 	F_STRING* string = untag_string_fast(dpop());

native/string.h

@@ -30,24 +30,40 @@ INLINE CELL string_size(CELL size)
 }
 
 F_STRING* allot_string(F_FIXNUM capacity);
-F_STRING* string(F_FIXNUM capacity, CELL fill);
-void primitive_string(void);
 void rehash_string(F_STRING* str);
 void primitive_rehash_string(void);
-F_STRING* resize_string(F_STRING* string, F_FIXNUM capacity, u16 fill);
+F_STRING* string(F_FIXNUM capacity, CELL fill);
+void primitive_string(void);
+F_STRING *resize_string(F_STRING *string, F_FIXNUM capacity, u16 fill);
 void primitive_resize_string(void);
-F_ARRAY *string_to_alien(F_STRING *s, bool check);
-char* to_c_string(F_STRING* s, bool check);
-void string_to_memory(F_STRING* s, BYTE* string);
-void primitive_string_to_memory(void);
-DLLEXPORT void box_c_string(const char* c_string);
-F_STRING* from_c_string(const char* c_string);
-F_STRING* memory_to_string(const BYTE* string, CELL length);
-void primitive_memory_to_string(void);
-DLLEXPORT char* unbox_c_string(void);
-char *pop_c_string(void);
-DLLEXPORT u16* unbox_utf16_string(void);
-DLLEXPORT void box_utf16_string(u16 *unboxed);
+
+F_STRING *memory_to_char_string(const char *string, CELL length);
+void primitive_memory_to_char_string(void);
+F_STRING *from_char_string(const char *c_string);
+DLLEXPORT void box_char_string(const char *c_string);
+void primitive_alien_to_char_string(void);
+
+F_STRING *memory_to_u16_string(const u16 *string, CELL length);
+void primitive_memory_to_u16_string(void);
+F_STRING *from_u16_string(const u16 *c_string);
+DLLEXPORT void box_u16_string(const u16 *c_string);
+void primitive_alien_to_u16_string(void);
+
+void char_string_to_memory(F_STRING *s, char *string);
+void primitive_char_string_to_memory(void);
+F_ARRAY *string_to_char_alien(F_STRING *s, bool check);
+char* to_char_string(F_STRING *s, bool check);
+char *pop_char_string(void);
+DLLEXPORT char *unbox_char_string(void);
+void primitive_string_to_char_alien(void);
+
+void u16_string_to_memory(F_STRING *s, u16 *string);
+void primitive_u16_string_to_memory(void);
+F_ARRAY *string_to_u16_alien(F_STRING *s, bool check);
+u16* to_u16_string(F_STRING *s, bool check);
+u16 *pop_u16_string(void);
+DLLEXPORT u16 *unbox_u16_string(void);
+void primitive_string_to_u16_alien(void);
 
 /* untagged & unchecked */
 INLINE CELL string_nth(F_STRING* string, CELL index)

native/unix/ffi.c

@@ -9,14 +9,14 @@ void init_ffi(void)
 
 void ffi_dlopen(DLL *dll, bool error)
 {
-	void *dllptr = dlopen(to_c_string(untag_string(dll->path),true), RTLD_LAZY);
+	void *dllptr = dlopen(to_char_string(untag_string(dll->path),true), RTLD_LAZY);
 
 	if(dllptr == NULL)
 	{
 		if(error)
 		{
 			general_error(ERROR_FFI,tag_object(
-				from_c_string(dlerror())),F,true);
+				from_char_string(dlerror())),F,true);
 		}
 		else
 			dll->dll = NULL;
@@ -30,13 +30,13 @@ void ffi_dlopen(DLL *dll, bool error)
 void *ffi_dlsym(DLL *dll, F_STRING *symbol, bool error)
 {
 	void *handle = (dll == NULL ? null_dll : dll->dll);
-	void *sym = dlsym(handle,to_c_string(symbol,true));
+	void *sym = dlsym(handle,to_char_string(symbol,true));
 	if(sym == NULL)
 	{
 		if(error)
 		{
 			general_error(ERROR_FFI,tag_object(
-				from_c_string(dlerror())),F,true);
+				from_char_string(dlerror())),F,true);
 		}
 
 		return NULL;
@@ -49,7 +49,7 @@ void ffi_dlclose(DLL *dll)
 	if(dlclose(dll->dll))
 	{
 		general_error(ERROR_FFI,tag_object(
-			from_c_string(dlerror())),F,true);
+			from_char_string(dlerror())),F,true);
 	}
 	dll->dll = NULL;
 }

native/unix/file.c

@@ -8,7 +8,7 @@ void primitive_stat(void)
 	maybe_gc(0);
 
 	path = untag_string(dpop());
-	if(stat(to_c_string(path,true),&sb) < 0)
+	if(stat(to_char_string(path,true),&sb) < 0)
 		dpush(F);
 	else
 	{
@@ -32,14 +32,14 @@ void primitive_read_dir(void)
 	result = array(ARRAY_TYPE,100,F);
 
 	path = untag_string(dpop());
-	dir = opendir(to_c_string(path,true));
+	dir = opendir(to_char_string(path,true));
 	if(dir != NULL)
 	{
 		struct dirent* file;
 
 		while((file = readdir(dir)) != NULL)
 		{
-			CELL name = tag_object(from_c_string(file->d_name));
+			CELL name = tag_object(from_char_string(file->d_name));
 			if(result_count == array_capacity(result))
 			{
 				result = resize_array(result,
@@ -64,12 +64,12 @@ void primitive_cwd(void)
 	maybe_gc(0);
 	if(getcwd(wd,MAXPATHLEN) == NULL)
 		io_error();
-	box_c_string(wd);
+	box_char_string(wd);
 }
 
 void primitive_cd(void)
 {
 	maybe_gc(0);
-	chdir(pop_c_string());
+	chdir(pop_char_string());
 }