More allot_* work

TODO.FACTOR.txt

@@ -11,6 +11,7 @@
 
 + ui:
 
+- input operation: copy
 - docs: mention that 'like' may destroy the underlying sequence
 - live search: timer delay would be nice
 - menu should stay up if mouse button released
@@ -76,6 +77,7 @@
 
 + misc:
 
+- faster apropos
 - growable data heap
 - minor GC takes too long now, we should card mark code heap
 - buffer-ptr should be an alien

library/io/files.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io
 USING: hashtables kernel math memory namespaces sequences
-strings styles ;
+strings styles arrays ;
 
 ! Words for accessing filesystem meta-data.
 

vm/data_gc.h

@@ -180,13 +180,14 @@ void garbage_collection(CELL gen, bool code_gc);
 #define REGISTER_ROOT(obj) rpush(obj)
 #define UNREGISTER_ROOT(obj) obj = rpop()
 
-/* WARNING: only call this from a context where all local variables
+#define REGISTER_ARRAY(obj) rpush(tag_object(obj))
-are also reachable via the GC roots, or gc_off is set to true. */
+#define UNREGISTER_ARRAY(obj) obj = untag_array_fast(rpop())
-INLINE void maybe_gc(CELL size)
+
-{
+#define REGISTER_STRING(obj) rpush(tag_object(obj))
-	if(nursery.here + size > nursery.limit)
+#define UNREGISTER_STRING(obj) obj = untag_string_fast(rpop())
-		garbage_collection(NURSERY,false);
+
-}
+#define REGISTER_C_STRING(obj) rpush(tag_object(((F_ARRAY *)obj) - 1))
+#define UNREGISTER_C_STRING(obj) obj = ((char*)(untag_array_fast(rpop()) + 1))
 
 INLINE void *allot_zone(ZONE *z, CELL a)
 {
@@ -199,7 +200,9 @@ INLINE void *allot_zone(ZONE *z, CELL a)
 
 INLINE void *allot(CELL a)
 {
-	maybe_gc(a);
+	if(nursery.here + a > nursery.limit)
+		garbage_collection(NURSERY,false);
+
 	return allot_zone(&nursery,a);
 }
 

vm/io.c

@@ -26,12 +26,11 @@ void io_error(void)
 
 void primitive_fopen(void)
 {
-	char *path, *mode;
+	char *mode = unbox_char_string();
-	FILE* file;
+	REGISTER_C_STRING(mode);
-	maybe_gc(0);
+	char *path = unbox_char_string();
-	mode = unbox_char_string();
+	UNREGISTER_C_STRING(mode);
-	path = unbox_char_string();
+	FILE *file = fopen(path,mode);
-	file = fopen(path,mode);
 	if(file == NULL)
 		io_error();
 	box_alien((CELL)file);

vm/math.c

@@ -401,7 +401,6 @@ void primitive_bignum_greatereq(void)
 
 void primitive_bignum_not(void)
 {
-	maybe_gc(0);
 	drepl(tag_bignum(s48_bignum_bitwise_not(
 		untag_bignum_fast(dpeek()))));
 }
@@ -512,13 +511,9 @@ void primitive_to_float(void)
 
 void primitive_str_to_float(void)
 {
-	F_STRING* str;
 	char *c_str, *end;
 	double f;
-
+	F_STRING *str = untag_string(dpeek());
-	maybe_gc(sizeof(F_FLOAT));
-
-	str = untag_string(dpeek());
 
 	/* if the string has nulls or chars > 255, its definitely not a float */
 	if(!check_string(str,sizeof(char)))
@@ -538,71 +533,67 @@ void primitive_str_to_float(void)
 void primitive_float_to_str(void)
 {
 	char tmp[33];
-
+	snprintf(tmp,32,"%.16g",unbox_double());
-	maybe_gc(sizeof(F_FLOAT));
-
-	snprintf(tmp,32,"%.16g",to_float(dpop()));
 	tmp[32] = '\0';
 	box_char_string(tmp);
 }
 
-#define GC_AND_POP_FLOATS(x,y) \
+#define POP_FLOATS(x,y) \
 	double x, y; \
-	maybe_gc(sizeof(F_FLOAT)); \
 	y = untag_float_fast(dpop()); \
 	x = untag_float_fast(dpop());
 
 void primitive_float_add(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_float(x + y);
 }
 
 void primitive_float_subtract(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_float(x - y);
 }
 
 void primitive_float_multiply(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_float(x * y);
 }
 
 void primitive_float_divfloat(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_float(x / y);
 }
 
 void primitive_float_mod(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_float(fmod(x,y));
 }
 
 void primitive_float_less(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_boolean(x < y);
 }
 
 void primitive_float_lesseq(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_boolean(x <= y);
 }
 
 void primitive_float_greater(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_boolean(x > y);
 }
 
 void primitive_float_greatereq(void)
 {
-	GC_AND_POP_FLOATS(x,y);
+	POP_FLOATS(x,y);
 	box_boolean(x >= y);
 }
 

vm/os-unix.c

@@ -83,24 +83,20 @@ void primitive_stat(void)
 
 void primitive_read_dir(void)
 {
-	F_STRING *path;
+	DIR* dir = opendir(unbox_char_string());
-	DIR* dir;
-	F_ARRAY *result;
 	CELL result_count = 0;
+	F_ARRAY *result = allot_array(ARRAY_TYPE,100,F);
 
-	maybe_gc(0);
-
-	result = allot_array(ARRAY_TYPE,100,F);
-
-	path = untag_string(dpop());
-	dir = opendir(to_char_string(path,true));
 	if(dir != NULL)
 	{
 		struct dirent* file;
 
 		while((file = readdir(dir)) != NULL)
 		{
+			REGISTER_ARRAY(result);
 			CELL name = tag_object(from_char_string(file->d_name));
+			UNREGISTER_ARRAY(result);
+
 			if(result_count == array_capacity(result))
 			{
 				result = reallot_array(result,
@@ -122,7 +118,6 @@ void primitive_read_dir(void)
 void primitive_cwd(void)
 {
 	char wd[MAXPATHLEN];
-	maybe_gc(0);
 	if(getcwd(wd,MAXPATHLEN) == NULL)
 		io_error();
 	box_char_string(wd);
@@ -130,7 +125,6 @@ void primitive_cwd(void)
 
 void primitive_cd(void)
 {
-	maybe_gc(0);
 	chdir(unbox_char_string());
 }
 

vm/os-windows.c

@@ -118,22 +118,21 @@ void primitive_read_dir(void)
 {
 	HANDLE dir;
 	WIN32_FIND_DATA find_data;
-	F_ARRAY *result;
 	CELL result_count = 0;
 	char path[MAX_PATH + 4];
 
-	maybe_gc(0);
+	sprintf(path, "%s\\*", unbox_char_string());
 
-	result = array(ARRAY_TYPE,100,F);
+	F_ARRAY *result = allot_array(ARRAY_TYPE,100,F);
-
-	sprintf(path, "%s\\*", to_char_string(untag_string(dpop()),true));
 
 	if(INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data)))
 	{
 		do
 		{
+			REGISTER_ARRAY(result);
 			CELL name = tag_object(from_char_string(
 				find_data.cFileName));
+			UNREGISTER_ARRAY(result);
 
 			if(result_count == array_capacity(result))
 			{
@@ -157,7 +156,6 @@ void primitive_cwd(void)
 {
 	char buf[MAX_PATH];
 
-	maybe_gc(0);
 	if(!GetCurrentDirectory(MAX_PATH, buf))
 		io_error();
 
@@ -166,7 +164,6 @@ void primitive_cwd(void)
 
 void primitive_cd(void)
 {
-	maybe_gc(0);
 	SetCurrentDirectory(unbox_char_string());
 }
 

vm/run.c

@@ -166,16 +166,12 @@ void primitive_exit(void)
 
 void primitive_os_env(void)
 {
-	char *name, *value;
+	char *name = unbox_char_string();
-
+	char *value = getenv(name);
-	maybe_gc(0);
-
-	name = unbox_char_string();
-	value = getenv(name);
 	if(value == NULL)
 		dpush(F);
 	else
-		box_char_string(getenv(name));
+		box_char_string(value);
 }
 
 void primitive_eq(void)
@@ -187,8 +183,7 @@ void primitive_eq(void)
 
 void primitive_millis(void)
 {
-	maybe_gc(0);
+	box_unsigned_8(current_millis());
-	dpush(tag_bignum(s48_long_long_to_bignum(current_millis())));
 }
 
 void primitive_type(void)
@@ -294,7 +289,8 @@ void memory_protection_error(CELL addr, int signal)
 		general_error(ERROR_CS_UNDERFLOW,F,F,false);
 	else if(in_page(addr, cs_bot, cs_size, 0))
 		general_error(ERROR_CS_OVERFLOW,F,F,false);
-	else
+	else if(in_page(addr, nursery.limit, 0, 0))
+		critical_error("Out of memory",0);
 		signal_error(signal);
 }
 

vm/types.c

@@ -115,13 +115,13 @@ F_ARRAY *reallot_array(F_ARRAY* array, F_FIXNUM capacity, CELL fill)
 	if(capacity < to_copy)
 		to_copy = capacity;
 
-	REGISTER_ROOT(tag_object(array));
+	REGISTER_ARRAY(array);
 	REGISTER_ROOT(fill);
 
 	new_array = allot_array_internal(untag_header(array->header),capacity);
 
 	UNREGISTER_ROOT(fill);
-	array = untag_array_fast(rpop());
+	UNREGISTER_ARRAY(array);
 
 	memcpy(new_array + 1,array + 1,to_copy * CELLS);
 	
@@ -221,11 +221,11 @@ F_STRING* reallot_string(F_STRING* string, F_FIXNUM capacity, u16 fill)
 	if(capacity < to_copy)
 		to_copy = capacity;
 
-	REGISTER_ROOT(tag_object(string));
+	REGISTER_STRING(string);
 
 	F_STRING *new_string = allot_string_internal(capacity);
 
-	string = untag_string_fast(rpop());
+	UNREGISTER_STRING(string);
 
 	memcpy(new_string + 1,string + 1,to_copy * CHARS);
 
@@ -239,7 +239,7 @@ void primitive_resize_string(void)
 {
 	F_STRING* string = untag_string_fast(dpop());
 	F_FIXNUM capacity = unbox_signed_cell();
-	drepl(tag_object(reallot_string(string,capacity,0)));
+	dpush(tag_object(reallot_string(string,capacity,0)));
 }
 
 /* Some ugly macros to prevent a 2x code duplication */
@@ -276,7 +276,6 @@ void primitive_resize_string(void)
 	} \
 	void primitive_alien_to_##type##_string(void) \
 	{ \
-		maybe_gc(0); \
 		drepl(tag_object(from_##type##_string(alien_offset(dpeek())))); \
 	}
 
@@ -345,7 +344,6 @@ F_ARRAY *allot_c_string(CELL capacity, CELL size)
 	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) \