string>memory and memory>string primitives

factor/jedit/WordListDialog.java

@@ -90,8 +90,10 @@ public abstract class WordListDialog extends EnhancedDialog
 
 		try
 		{
-			preview.setText(FactorPlugin.evalInWire(
-				FactorPlugin.factorWord(word) + " see").trim());
+			String text = FactorPlugin.evalInWire(
+				FactorPlugin.factorWord(word) + " see").trim();
+			preview.setText(text);
+			preview.setCaretPosition(text.length());
 		}
 		catch(Exception e)
 		{

factor/parser/Traits.java

@@ -42,6 +42,9 @@ public class Traits extends FactorParsingDefinition
 		throws Exception
 	{
 		FactorWord w = reader.nextWord(true);
+		if(w == null)
+			return;
+
 		w.def = new FactorTraitsDefinition(w);
 		reader.intern("<" + w.name + ">",true);
 		reader.intern(w.name + "?",true);

library/bootstrap/primitives.factor

@@ -237,6 +237,8 @@ vocabularies get [
     [ "alien" | "set-alien-1" ]
     [ "kernel" | "heap-stats" ]
     [ "errors" | "throw" ]
+    [ "kernel-internals" | "string>memory" ]
+    [ "kernel-internals" | "memory>string" ]
 ] [
     unswons create swap succ [ f define ] keep
 ] each drop

library/primitives.factor

@@ -31,6 +31,7 @@ USE: errors
 USE: files
 USE: io-internals
 USE: kernel
+USE: kernel-internals
 USE: lists
 USE: math
 USE: math-internals
@@ -227,6 +228,8 @@ USE: words
     [ set-alien-1            " n alien off -- "                   [ 3 | 0 ] ]
     [ heap-stats             " -- instances bytes "               [ 0 | 2 ] ]
     [ throw                  " error -- "                         [ 1 | 0 ] ]
+    [ string>memory          " str address -- "                   [ 2 | 0 ] ]
+    [ memory>string          " address length -- str "            [ 2 | 1 ] ]
 ] [
     uncons dupd uncons car ( word word stack-effect infer-effect )
     >r "stack-effect" set-word-property r>

library/tools/debugger.factor

@@ -78,9 +78,6 @@ USE: math
 : negative-array-size-error ( obj -- )
     "Cannot allocate array with negative size " write . ;
 
-: bad-primitive-error ( obj -- )
-    "Bad primitive number: " write . ;
-
 : c-string-error ( obj -- )
     "Cannot convert to C string: " write . ;
 
@@ -106,7 +103,6 @@ USE: math
         float-format-error
         signal-error
         negative-array-size-error
-        bad-primitive-error
         c-string-error
         ffi-disabled-error
         ffi-error

native/error.h

@@ -9,11 +9,10 @@
 #define ERROR_FLOAT_FORMAT (8<<3)
 #define ERROR_SIGNAL (9<<3)
 #define ERROR_NEGATIVE_ARRAY_SIZE (10<<3)
-#define ERROR_BAD_PRIMITIVE (11<<3)
-#define ERROR_C_STRING (12<<3)
-#define ERROR_FFI_DISABLED (13<<3)
-#define ERROR_FFI (14<<3)
-#define ERROR_CLOSED (15<<3)
+#define ERROR_C_STRING (11<<3)
+#define ERROR_FFI_DISABLED (12<<3)
+#define ERROR_FFI (13<<3)
+#define ERROR_CLOSED (14<<3)
 
 /* When throw_error throws an error, it sets this global and
 longjmps back to the top-level. */

native/primitives.c

@@ -189,13 +189,15 @@ XT primitives[] = {
 	primitive_alien_1,
 	primitive_set_alien_1,
 	primitive_heap_stats,
-	primitive_throw
+	primitive_throw,
+	primitive_string_to_memory,
+	primitive_memory_to_string
 };
 
 CELL primitive_to_xt(CELL primitive)
 {
 	if(primitive < 0 || primitive >= PRIMITIVE_COUNT)
-		general_error(ERROR_BAD_PRIMITIVE,tag_fixnum(primitive));
-
-	return (CELL)primitives[primitive];
+		return (CELL)undefined;
+	else
+		return (CELL)primitives[primitive];
 }

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 189
+#define PRIMITIVE_COUNT 191
 
 CELL primitive_to_xt(CELL primitive);

native/string.c

@@ -59,17 +59,15 @@ F_STRING* grow_string(F_STRING* string, F_FIXNUM capacity, uint16_t fill)
 	return new_string;
 }
 
-/* untagged */
-F_STRING* from_c_string(const BYTE* c_string)
+INLINE F_STRING* memory_to_string(const BYTE* string, CELL length)
 {
-	CELL length = strlen(c_string);
 	F_STRING* s = allot_string(length);
 	CELL i;
 
 	for(i = 0; i < length; i++)
 	{
-		cput(SREF(s,i),*c_string);
-		c_string++;
+		cput(SREF(s,i),*string);
+		string++;
 	}
 
 	rehash_string(s);
@@ -77,6 +75,19 @@ F_STRING* from_c_string(const BYTE* c_string)
 	return s;
 }
 
+void primitive_memory_to_string(void)
+{
+	CELL length = unbox_cell();
+	BYTE* string = (BYTE*)unbox_cell();
+	dpush(tag_object(memory_to_string(string,length)));
+}
+
+/* untagged */
+F_STRING* from_c_string(const BYTE* c_string)
+{
+	return memory_to_string(c_string,strlen(c_string));
+}
+
 /* FFI calls this */
 void box_c_string(const BYTE* c_string)
 {
@@ -98,19 +109,27 @@ BYTE* to_c_string(F_STRING* s)
 	return to_c_string_unchecked(s);
 }
 
+INLINE void string_to_memory(F_STRING* s, BYTE* string)
+{
+	CELL i;
+	for(i = 0; i < s->capacity; i++)
+		string[i] = string_nth(s,i);
+}
+
+void primitive_string_to_memory(void)
+{
+	F_STRING* str = untag_string(dpop());
+	BYTE* address = (BYTE*)unbox_cell();
+	string_to_memory(str,address);
+}
+
 /* untagged */
 BYTE* to_c_string_unchecked(F_STRING* s)
 {
 	F_STRING* _c_str = allot_string(s->capacity / CHARS + 1);
-	CELL i;
-
 	BYTE* c_str = (BYTE*)(_c_str + 1);
-	
-	for(i = 0; i < s->capacity; i++)
-		c_str[i] = string_nth(s,i);
-
+	string_to_memory(s,c_str);
 	c_str[s->capacity] = '\0';
-
 	return c_str;
 }
 

native/string.h

@@ -19,8 +19,10 @@ void rehash_string(F_STRING* str);
 F_STRING* grow_string(F_STRING* string, F_FIXNUM capacity, uint16_t fill);
 BYTE* to_c_string(F_STRING* s);
 BYTE* to_c_string_unchecked(F_STRING* s);
+void primitive_string_to_memory(void);
 DLLEXPORT void box_c_string(const BYTE* c_string);
 F_STRING* from_c_string(const BYTE* c_string);
+void primitive_memory_to_string(void);
 DLLEXPORT BYTE* unbox_c_string(void);
 
 #define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index * CHARS)