From fbfad839573273d74384b78bcf14417dcaf557dc Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Mon, 15 May 2006 04:03:55 +0000
Subject: [PATCH] Remove cons usage from runtime

---
 library/compiler/generator/xt.factor | 10 ++---
 library/io/files.factor              |  6 +--
 library/tools/debugger.factor        | 58 +++++++++++++---------------
 library/tools/memory.factor          |  2 +-
 native/alien.c                       |  2 +-
 native/array.c                       | 22 ++++++++++-
 native/array.h                       |  5 ++-
 native/debug.c                       |  2 +-
 native/dll.c                         |  2 +-
 native/error.c                       | 20 ++--------
 native/error.h                       |  3 +-
 native/factor.c                      | 13 ++++---
 native/float.c                       |  2 +-
 native/io.c                          |  2 +-
 native/macosx/run.m                  |  2 +-
 native/memory.c                      | 13 +++----
 native/relocate.c                    |  8 ++--
 native/run.c                         |  2 +-
 native/sbuf.c                        |  2 +-
 native/string.c                      |  6 +--
 native/unix/ffi.c                    |  6 +--
 native/unix/file.c                   | 32 ++++++++-------
 native/unix/signal.c                 | 12 ++++--
 native/windows/file.c                | 30 +++++++++-----
 24 files changed, 143 insertions(+), 119 deletions(-)

diff --git a/library/compiler/generator/xt.factor b/library/compiler/generator/xt.factor
index c2962af6b7..f2f70e34fe 100644
--- a/library/compiler/generator/xt.factor
+++ b/library/compiler/generator/xt.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: compiler
-USING: assembler errors generic hashtables kernel
-kernel-internals lists math namespaces prettyprint queues
+USING: arrays assembler errors generic hashtables kernel
+kernel-internals math namespaces prettyprint queues
 sequences strings vectors words ;
 
 : <label> ( -- label )
@@ -57,7 +57,7 @@ SYMBOL: relocation-table
     compiled-offset r> rel-absolute-cell = cell 4 ? - rel, ;
 
 : rel-dlsym ( name dll class -- )
-    >r cons add-literal compiled-base - cell / r>
+    >r 2array add-literal compiled-base - cell / r>
     1 rel-type, ;
 
 : rel-address ( class -- )
diff --git a/library/io/files.factor b/library/io/files.factor
index 2d63f3b4b2..66c88423e3 100644
--- a/library/io/files.factor
+++ b/library/io/files.factor
@@ -1,5 +1,5 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: io
 USING: hashtables kernel lists math memory namespaces sequences
 strings styles ;
@@ -11,7 +11,7 @@ strings styles ;
 
 : exists? ( file -- ? ) stat >boolean ;
 
-: directory? ( file -- ? ) stat car ;
+: directory? ( file -- ? ) stat first ;
 
 : directory ( dir -- list )
     (directory)
diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor
index bfd702ed65..656deb204a 100644
--- a/library/tools/debugger.factor
+++ b/library/tools/debugger.factor
@@ -1,42 +1,42 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: errors
-USING: generic hashtables inspector io kernel kernel-internals
-lists math namespaces parser prettyprint sequences
+USING: arrays generic hashtables inspector io kernel
+kernel-internals math namespaces parser prettyprint sequences
 sequences-internals strings vectors words ;
 
 SYMBOL: error
 SYMBOL: error-continuation
 
 : expired-error. ( obj -- )
-    "Object did not survive image save/load: " write . ;
+    "Object did not survive image save/load: " write third . ;
 
 : undefined-word-error. ( obj -- )
-    "Undefined word: " write . ;
+    "Undefined word: " write third . ;
 
 : io-error. ( error -- )
-    "I/O error: " write print ;
+    "I/O error: " write third print ;
 
 : type-check-error. ( list -- )
     "Type check error" print
-    uncons car dup "Object: " write short.
-    "Object type: " write class .
-    "Expected type: " write type>class . ;
+    "Object: " write dup fourth short.
+    "Object type: " write dup fourth class .
+    "Expected type: " write third type>class . ;
 
 : float-format-error. ( list -- )
-    "Invalid floating point literal format: " write . ;
+    "Invalid floating point literal format: " write third . ;
 
 : signal-error. ( obj -- )
-    "Operating system signal " write . ;
+    "Operating system signal " write third . ;
 
 : negative-array-size-error. ( obj -- )
-    "Cannot allocate array with negative size " write . ;
+    "Cannot allocate array with negative size " write third . ;
 
 : c-string-error. ( obj -- )
-    "Cannot convert to C string: " write . ;
+    "Cannot convert to C string: " write third . ;
 
 : ffi-error. ( obj -- )
-    "FFI: " write print ;
+    "FFI: " write third print ;
 
 : heap-scan-error. ( obj -- )
     "Cannot do next-object outside begin/end-scan" print drop ;
@@ -48,27 +48,21 @@ SYMBOL: error-continuation
 : user-interrupt. ( obj -- )
     "User interrupt" print drop ;
 
-: datastack-underflow. ( obj -- )
-    "Data stack underflow" print drop ;
+: stack-underflow. ( obj name -- )
+    write " stack underflow" print drop ;
 
-: datastack-overflow. ( obj -- )
-    "Data stack overflow" print drop ;
-
-: callstack-underflow. ( obj -- )
-    "Return stack underflow" print drop ;
-
-: callstack-overflow. ( obj -- )
-    "Return stack overflow" print drop ;
+: stack-overflow. ( obj name -- )
+    write " stack overflow" print drop ;
 
 ! Hook for library/cocoa/
 DEFER: objc-error. ( alien -- )
 
-PREDICATE: cons kernel-error ( obj -- ? )
-    dup first kernel-error = swap second 0 16 between? and ;
+PREDICATE: array kernel-error ( obj -- ? )
+    dup first kernel-error eq? swap second 0 18 between? and ;
 
 M: kernel-error error. ( error -- )
     #! Kernel errors are indexed by integers.
-    cdr uncons car swap {
+    dup second {
         [ expired-error. ]
         [ io-error. ]
         [ undefined-word-error. ]
@@ -81,10 +75,12 @@ M: kernel-error error. ( error -- )
         [ heap-scan-error. ]
         [ undefined-symbol-error. ]
         [ user-interrupt. ]
-        [ datastack-underflow. ]
-        [ datastack-overflow. ]
-        [ callstack-underflow. ]
-        [ callstack-overflow. ]
+        [ "Data" stack-underflow. ]
+        [ "Data" stack-overflow. ]
+        [ "Retain" stack-underflow. ]
+        [ "Retain" stack-overflow. ]
+        [ "Call" stack-underflow. ]
+        [ "Call" stack-overflow. ]
         [ objc-error. ]
     } dispatch ;
 
diff --git a/library/tools/memory.factor b/library/tools/memory.factor
index fdd18466e7..37a89b8d85 100644
--- a/library/tools/memory.factor
+++ b/library/tools/memory.factor
@@ -24,7 +24,7 @@ sequences strings vectors words ;
     room
     0 swap [
         "Generation " write over pprint ":" write
-        uncons (room.) 1+
+        first2 (room.) 1+
     ] each drop
     "Semi-space:  " write kb. terpri
     "Cards:       " write kb. terpri
diff --git a/native/alien.c b/native/alien.c
index 5e41b0839b..f9c98f83ff 100644
--- a/native/alien.c
+++ b/native/alien.c
@@ -30,7 +30,7 @@ void *alien_offset(CELL object)
 	case ALIEN_TYPE:
 		alien = untag_alien_fast(object);
 		if(alien->expired)
-			general_error(ERROR_EXPIRED,object,true);
+			general_error(ERROR_EXPIRED,object,F,true);
 		return alien_offset(alien->alien) + alien->displacement;
 	case F_TYPE:
 		return NULL;
diff --git a/native/array.c b/native/array.c
index 5ac8e6154f..94cd9fe683 100644
--- a/native/array.c
+++ b/native/array.c
@@ -7,7 +7,7 @@ F_ARRAY *allot_array(CELL type, F_FIXNUM capacity)
 	F_ARRAY *array;
 
 	if(capacity < 0)
-		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),true);
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),F,true);
 
 	array = allot_object(type,array_size(capacity));
 	array->capacity = tag_fixnum(capacity);
@@ -15,7 +15,7 @@ F_ARRAY *allot_array(CELL type, F_FIXNUM capacity)
 }
 
 /* make a new array with an initial element */
-F_ARRAY* array(CELL type, F_FIXNUM capacity, CELL fill)
+F_ARRAY *array(CELL type, F_FIXNUM capacity, CELL fill)
 {
 	int i;
 	F_ARRAY* array = allot_array(type, capacity);
@@ -42,6 +42,24 @@ void primitive_array(void)
 	dpush(tag_object(array(ARRAY_TYPE,size,initial)));
 }
 
+CELL make_array_2(CELL v1, CELL v2)
+{
+	F_ARRAY *a = array(ARRAY_TYPE,2,F);
+	put(AREF(a,0),v1);
+	put(AREF(a,1),v2);
+	return tag_object(a);
+}
+
+CELL make_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
+{
+	F_ARRAY *a = array(ARRAY_TYPE,4,F);
+	put(AREF(a,0),v1);
+	put(AREF(a,1),v2);
+	put(AREF(a,2),v3);
+	put(AREF(a,3),v4);
+	return tag_object(a);
+}
+
 /* push a new tuple on the stack */
 void primitive_tuple(void)
 {
diff --git a/native/array.h b/native/array.h
index 783e2c7667..ff8406ca2a 100644
--- a/native/array.h
+++ b/native/array.h
@@ -29,11 +29,14 @@ F_ARRAY *allot_array(CELL type, F_FIXNUM capacity);
 F_ARRAY *array(CELL type, F_FIXNUM capacity, CELL fill);
 F_ARRAY *byte_array(F_FIXNUM size);
 
+CELL make_array_2(CELL v1, CELL v2);
+CELL make_array_4(CELL v1, CELL v2, CELL v3, CELL v4);
+
 void primitive_array(void);
 void primitive_tuple(void);
 void primitive_byte_array(void);
 
-F_ARRAY* resize_array(F_ARRAY* array, F_FIXNUM capacity, CELL fill);
+F_ARRAY *resize_array(F_ARRAY* array, F_FIXNUM capacity, CELL fill);
 void primitive_resize_array(void);
 void primitive_array_to_tuple(void);
 void primitive_tuple_to_array(void);
diff --git a/native/debug.c b/native/debug.c
index 7aab3e2ae4..d15a100307 100644
--- a/native/debug.c
+++ b/native/debug.c
@@ -261,7 +261,7 @@ void factorbug(void)
 			fprintf(stderr,"%lx\n",(CELL)CARD_TO_ADDR(card));
 		}
 		else if(strcmp(cmd,"t") == 0)
-			general_error(ERROR_USER_INTERRUPT,F,true);
+			general_error(ERROR_USER_INTERRUPT,F,F,true);
 		else if(strcmp(cmd,"q") == 0)
 			return;
 		else if(strcmp(cmd,"x") == 0)
diff --git a/native/dll.c b/native/dll.c
index 01d59f0aae..80543ea247 100644
--- a/native/dll.c
+++ b/native/dll.c
@@ -32,7 +32,7 @@ void primitive_dlsym(void)
 	{
 		d = untag_dll(dll);
 		if(d->dll == NULL)
-			general_error(ERROR_EXPIRED,dll,true);
+			general_error(ERROR_EXPIRED,dll,F,true);
 	}
 
 	dpush(tag_cell((CELL)ffi_dlsym(d,sym,true)));
diff --git a/native/error.c b/native/error.c
index b098fc1767..fb33fea994 100644
--- a/native/error.c
+++ b/native/error.c
@@ -51,9 +51,9 @@ void primitive_die(void)
 	factorbug();
 }
 
-void general_error(CELL error, CELL tagged, bool keep_stacks)
+void general_error(CELL error, CELL arg1, CELL arg2, bool keep_stacks)
 {
-	CELL thrown = cons(userenv[ERROR_ENV],cons(error,cons(tagged,F)));
+	CELL thrown = make_array_4(userenv[ERROR_ENV],error,arg1,arg2);
 	throw_error(thrown,keep_stacks);
 }
 
@@ -61,22 +61,10 @@ void general_error(CELL error, CELL tagged, bool keep_stacks)
 touch it */
 void signal_error(int signal)
 {
-	general_error(ERROR_SIGNAL,tag_fixnum(signal),false);
-}
-
-/* called from signal.c when a sigv tells us that we under/overflowed a page.
- * The first bool is true if it was the return stack (otherwise it's the data
- * stack) and the second bool is true if we overflowed it (otherwise we
- * underflowed it) */
-void signal_stack_error(bool is_return_stack, bool is_overflow)
-{
-	CELL errors[] = { ERROR_DS_UNDERFLOW, ERROR_DS_OVERFLOW,
-			  ERROR_CS_UNDERFLOW, ERROR_CS_OVERFLOW };
-	general_error(errors[is_return_stack * 2 + is_overflow],F,false);
+	general_error(ERROR_SIGNAL,tag_fixnum(signal),F,false);
 }
 
 void type_error(CELL type, CELL tagged)
 {
-	CELL c = cons(tag_fixnum(type),cons(tagged,F));
-	general_error(ERROR_TYPE,c,true);
+	general_error(ERROR_TYPE,tag_fixnum(type),tagged,true);
 }
diff --git a/native/error.h b/native/error.h
index faa3b8f2f0..a0dee47e64 100644
--- a/native/error.h
+++ b/native/error.h
@@ -36,9 +36,8 @@ void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);
 void throw_error(CELL error, bool keep_stacks);
 void early_error(CELL error);
-void general_error(CELL error, CELL tagged, bool keep_stacks);
+void general_error(CELL error, CELL arg1, CELL arg2, bool keep_stacks);
 void signal_error(int signal);
-void signal_stack_error(bool is_return_stack, bool is_overflow);
 void type_error(CELL type, CELL tagged);
 void primitive_throw(void);
 void primitive_die(void);
diff --git a/native/factor.c b/native/factor.c
index e6f8b8ba40..9b011cbafe 100644
--- a/native/factor.c
+++ b/native/factor.c
@@ -64,7 +64,8 @@ int main(int argc, char** argv)
 	CELL aging_size = 4 * CELLS;
 	CELL code_size = CELLS;
 	CELL literal_size = 128;
-	CELL args;
+	F_ARRAY *args;
+	CELL arg_count;
 	CELL i;
 	bool image_given = true;
 
@@ -107,13 +108,15 @@ int main(int argc, char** argv)
 		code_size * 1024 * 1024,
 		literal_size * 1024);
 
-	args = F;
-	while(--argc > (image_given ? 1 : 0))
+	arg_count = (image_given ? 2 : 1);
+	args = array(ARRAY_TYPE,argc,F);
+	while(arg_count < argc)
 	{
-		args = cons(tag_object(from_c_string(argv[argc])),args);
+		put(AREF(args,arg_count),tag_object(from_c_string(argv[arg_count])));
+		arg_count++;
 	}
 
-	userenv[ARGS_ENV] = args;
+	userenv[ARGS_ENV] = tag_object(args);
 
 	platform_run();
 
diff --git a/native/float.c b/native/float.c
index c0d6e2c224..f531c14b2a 100644
--- a/native/float.c
+++ b/native/float.c
@@ -44,7 +44,7 @@ void primitive_str_to_float(void)
 	end = c_str;
 	f = strtod(c_str,&end);
 	if(end != c_str + string_capacity(str))
-		general_error(ERROR_FLOAT_FORMAT,tag_object(str),true);
+		general_error(ERROR_FLOAT_FORMAT,tag_object(str),F,true);
 	drepl(tag_float(f));
 }
 
diff --git a/native/io.c b/native/io.c
index cfc1e6bd54..d61a580e4f 100644
--- a/native/io.c
+++ b/native/io.c
@@ -27,7 +27,7 @@ void init_c_io(void)
 void io_error(void)
 {
 	CELL error = tag_object(from_c_string(strerror(errno)));
-	general_error(ERROR_IO,error,true);
+	general_error(ERROR_IO,error,F,true);
 }
 
 void primitive_fopen(void)
diff --git a/native/macosx/run.m b/native/macosx/run.m
index 6e4d69ce2e..e678ca4908 100644
--- a/native/macosx/run.m
+++ b/native/macosx/run.m
@@ -23,7 +23,7 @@ NS_DURING
 		{
 			CELL e = error;
 			error = F;
-			general_error(ERROR_OBJECTIVE_C,e,true);
+			general_error(ERROR_OBJECTIVE_C,e,F,true);
 		}
 
 		run();
diff --git a/native/memory.c b/native/memory.c
index 2cb9c3c54b..865430e513 100644
--- a/native/memory.c
+++ b/native/memory.c
@@ -154,20 +154,19 @@ void primitive_clone(void)
 
 void primitive_room(void)
 {
-	CELL list = F;
+	F_ARRAY *a = array(ARRAY_TYPE,gen_count,F);
 	int gen;
 	box_unsigned_cell(compiling.limit - compiling.here);
 	box_unsigned_cell(compiling.limit - compiling.base);
 	box_unsigned_cell(cards_end - cards);
 	box_unsigned_cell(prior.limit - prior.base);
-	for(gen = gen_count - 1; gen >= 0; gen--)
+	for(gen = 0; gen < gen_count; gen++)
 	{
 		ZONE *z = &generations[gen];
-		list = cons(cons(tag_cell(z->limit - z->here),
-			tag_cell(z->limit - z->base)),
-			list);
+		put(AREF(a,gen),make_array_2(tag_cell(z->limit - z->here),
+			tag_cell(z->limit - z->base)));
 	}
-	dpush(list);
+	dpush(tag_object(a));
 }
 
 void primitive_begin_scan(void)
@@ -184,7 +183,7 @@ void primitive_next_object(void)
 	CELL size, type;
 
 	if(!heap_scan)
-		general_error(ERROR_HEAP_SCAN,F,true);
+		general_error(ERROR_HEAP_SCAN,F,F,true);
 
 	if(heap_scan_ptr >= tenured.here)
 	{
diff --git a/native/relocate.c b/native/relocate.c
index 4d0e9bf472..631b1e5f82 100644
--- a/native/relocate.c
+++ b/native/relocate.c
@@ -84,15 +84,15 @@ void relocate_data()
 
 void undefined_symbol(void)
 {
-	general_error(ERROR_UNDEFINED_SYMBOL,F,true);
+	general_error(ERROR_UNDEFINED_SYMBOL,F,F,true);
 }
 
 CELL get_rel_symbol(F_REL* rel)
 {
 	CELL arg = REL_ARGUMENT(rel);
-	F_CONS* cons = untag_cons(get(compiling.base + arg * sizeof(CELL)));
-	F_STRING* symbol = untag_string(cons->car);
-	DLL* dll = (cons->cdr == F ? NULL : untag_dll(cons->cdr));
+	F_ARRAY *pair = untag_array(get(compiling.base + arg * sizeof(CELL)));
+	F_STRING *symbol = untag_string(AREF(pair,0));
+	DLL* dll = (AREF(pair,1) == F ? NULL : untag_dll(AREF(pair,1)));
 	CELL sym;
 
 	if(dll != NULL && !dll->dll)
diff --git a/native/run.c b/native/run.c
index 819c98a0c9..e5296fb74a 100644
--- a/native/run.c
+++ b/native/run.c
@@ -84,7 +84,7 @@ void run_callback(CELL quot)
 /* XT of deferred words */
 void undefined(F_WORD* word)
 {
-	general_error(ERROR_UNDEFINED_WORD,tag_object(word),true);
+	general_error(ERROR_UNDEFINED_WORD,tag_object(word),F,true);
 }
 
 /* XT of compound definitions */
diff --git a/native/sbuf.c b/native/sbuf.c
index 6254015b7b..9ddf15aa9e 100644
--- a/native/sbuf.c
+++ b/native/sbuf.c
@@ -4,7 +4,7 @@ F_SBUF* sbuf(F_FIXNUM capacity)
 {
 	F_SBUF* sbuf;
 	if(capacity < 0)
-		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),true);
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),F,true);
 	sbuf = allot_object(SBUF_TYPE,sizeof(F_SBUF));
 	sbuf->top = tag_fixnum(0);
 	sbuf->string = tag_object(string(capacity,'\0'));
diff --git a/native/string.c b/native/string.c
index e26ec2e636..3918554d02 100644
--- a/native/string.c
+++ b/native/string.c
@@ -6,7 +6,7 @@ F_STRING* allot_string(F_FIXNUM capacity)
 	F_STRING* string;
 
 	if(capacity < 0)
-		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),true);
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),F,true);
 
 	string = allot_object(STRING_TYPE,
 		sizeof(F_STRING) + (capacity + 1) * CHARS);
@@ -133,7 +133,7 @@ F_ARRAY *string_to_alien(F_STRING *s, bool check)
 		{
 			u16 ch = string_nth(s,i);
 			if(ch == '\0' || ch > 255)
-				general_error(ERROR_C_STRING,tag_object(s),true);
+				general_error(ERROR_C_STRING,tag_object(s),F,true);
 		}
 	}
 
@@ -200,7 +200,7 @@ u16 *unbox_utf16_string(void)
 		for(i = 0; i < length; i++)
 		{
 			if(unboxed[i] == 0)
-				general_error(ERROR_C_STRING,obj,true);
+				general_error(ERROR_C_STRING,obj,F,true);
 		}
 
 		return unboxed;
diff --git a/native/unix/ffi.c b/native/unix/ffi.c
index eb4adbb530..2aa803cb6c 100644
--- a/native/unix/ffi.c
+++ b/native/unix/ffi.c
@@ -16,7 +16,7 @@ void ffi_dlopen(DLL *dll, bool error)
 		if(error)
 		{
 			general_error(ERROR_FFI,tag_object(
-				from_c_string(dlerror())),true);
+				from_c_string(dlerror())),F,true);
 		}
 		else
 			dll->dll = NULL;
@@ -36,7 +36,7 @@ void *ffi_dlsym(DLL *dll, F_STRING *symbol, bool error)
 		if(error)
 		{
 			general_error(ERROR_FFI,tag_object(
-				from_c_string(dlerror())),true);
+				from_c_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())),true);
+			from_c_string(dlerror())),F,true);
 	}
 	dll->dll = NULL;
 }
diff --git a/native/unix/file.c b/native/unix/file.c
index dea7f0af57..381c898633 100644
--- a/native/unix/file.c
+++ b/native/unix/file.c
@@ -16,25 +16,21 @@ void primitive_stat(void)
 		CELL mode = tag_fixnum(sb.st_mode & ~S_IFMT);
 		CELL size = tag_bignum(s48_long_long_to_bignum(sb.st_size));
 		CELL mtime = tag_integer(sb.st_mtime);
-		dpush(cons(
-			dirp,
-			cons(
-				mode,
-				cons(
-					size,
-					cons(
-						mtime,F)))));
+		dpush(make_array_4(dirp,mode,size,mtime));
 	}
 }
 
 void primitive_read_dir(void)
 {
-	F_STRING* path;
+	F_STRING *path;
 	DIR* dir;
-	CELL result = F;
+	F_ARRAY *result;
+	CELL result_count = 0;
 
 	maybe_gc(0);
 
+	result = array(ARRAY_TYPE,100,F);
+
 	path = untag_string(dpop());
 	dir = opendir(to_c_string(path,true));
 	if(dir != NULL)
@@ -43,15 +39,23 @@ void primitive_read_dir(void)
 
 		while((file = readdir(dir)) != NULL)
 		{
-			CELL name = tag_object(from_c_string(
-				file->d_name));
-			result = cons(name,result);
+			CELL name = tag_object(from_c_string(file->d_name));
+			if(result_count == array_capacity(result))
+			{
+				result = resize_array(result,
+					result_count * 2,F);
+			}
+			
+			put(AREF(result,result_count),name);
+			result_count++;
 		}
 
 		closedir(dir);
 	}
 
-	dpush(result);
+	result = resize_array(result,result_count,F);
+
+	dpush(tag_object(result));
 }
 
 void primitive_cwd(void)
diff --git a/native/unix/signal.c b/native/unix/signal.c
index 61520f681e..612949832d 100644
--- a/native/unix/signal.c
+++ b/native/unix/signal.c
@@ -19,13 +19,17 @@ static bool in_page(void *fault, void *i_area, CELL area_size, int offset)
 void signal_handler(int signal, siginfo_t* siginfo, void* uap)
 {
 	if(in_page(siginfo->si_addr, (void *) ds_bot, 0, -1))
-		signal_stack_error(false, false);
+		general_error(ERROR_DS_UNDERFLOW,F,F,false);
 	else if(in_page(siginfo->si_addr, (void *) ds_bot, ds_size, 0))
-		signal_stack_error(false, true);
+		general_error(ERROR_DS_OVERFLOW,F,F,false);
+	else if(in_page(siginfo->si_addr, (void *) rs_bot, 0, -1))
+		general_error(ERROR_RS_UNDERFLOW,F,F,false);
+	else if(in_page(siginfo->si_addr, (void *) rs_bot, rs_size, 0))
+		general_error(ERROR_RS_OVERFLOW,F,F,false);
 	else if(in_page(siginfo->si_addr, (void *) cs_bot, 0, -1))
-		signal_stack_error(true, false);
+		general_error(ERROR_CS_UNDERFLOW,F,F,false);
 	else if(in_page(siginfo->si_addr, (void *) cs_bot, cs_size, 0))
-		signal_stack_error(true, true);
+		general_error(ERROR_CS_OVERFLOW,F,F,false);
 	else
 		signal_error(signal);
 }
diff --git a/native/windows/file.c b/native/windows/file.c
index c005986282..2217c3af99 100644
--- a/native/windows/file.c
+++ b/native/windows/file.c
@@ -19,11 +19,7 @@ void primitive_stat(void)
 			(s64)st.nFileSizeLow | (s64)st.nFileSizeHigh << 32));
 		CELL mtime = tag_integer((int)
 			((*(s64*)&st.ftLastWriteTime - EPOCH_OFFSET) / 10000000));
-		dpush(
-			cons(dirp,
-			cons(tag_fixnum(0),
-			cons(size,
-			cons(mtime, F)))));
+		dpush(make_array_4(dirp,tag_fixnum(0),size,mtime));
 	}
 }
 
@@ -32,23 +28,37 @@ void primitive_read_dir(void)
 	F_STRING *path;
 	HANDLE dir;
 	WIN32_FIND_DATA find_data;
-	CELL result = F;
+	F_ARRAY *result;
+	CELL result_count = 0;
 
 	maybe_gc(0);
 
+	result = array(ARRAY_TYPE,100,F);
+
 	path = untag_string(dpop());
 	if (INVALID_HANDLE_VALUE != (dir = FindFirstFile(".\\*", &find_data)))
 	{
-		do 
+		do
 		{
-			CELL name = tag_object(from_c_string(find_data.cFileName));
-			result = cons(name, result);
+			CELL name = tag_object(from_c_string(
+				find_data.cFileName));
+
+			if(result_count == array_capacity(result))
+			{
+				result = resize_array(result,
+					result_count * 2,F);
+			}
+			
+			put(AREF(result,result_count),name);
+			result_count++;
 		} 
 		while (FindNextFile(dir, &find_data));
 		CloseHandle(dir);
 	}
 
-	dpush(result);
+	result = resize_array(result,result_count,F);
+
+	dpush(tag_object(result));
 }
 
 void primitive_cwd(void)