Clean up AGL's patch

library/tools/debugger.factor

@@ -48,20 +48,20 @@ SYMBOL: error-continuation
 : user-interrupt. ( obj -- )
     "User interrupt" print drop ;
 
-: stack-underflow. ( obj -- )
+: datastack-underflow. ( obj -- )
-    "Stack underflow" print drop ;
+    "Data stack underflow" print drop ;
 
-: stack-overflow. ( obj -- )
+: datastack-overflow. ( obj -- )
-    "Stack overflow" print drop ;
+    "Data stack overflow" print drop ;
 
-: return-stack-underflow. ( obj -- )
+: callstack-underflow. ( obj -- )
     "Return stack underflow" print drop ;
 
-: return-stack-overflow. ( obj -- )
+: callstack-overflow. ( obj -- )
     "Return stack overflow" print drop ;
 
 PREDICATE: cons kernel-error ( obj -- ? )
-    dup first kernel-error = swap second 0 11 between? and ;
+    dup first kernel-error = swap second 0 15 between? and ;
 
 M: kernel-error error. ( error -- )
     #! Kernel errors are indexed by integers.
@@ -78,10 +78,10 @@ M: kernel-error error. ( error -- )
         [ heap-scan-error. ]
         [ undefined-symbol-error. ]
         [ user-interrupt. ]
-	[ stack-underflow. ]
+        [ datastack-underflow. ]
-	[ stack-overflow. ]
+        [ datastack-overflow. ]
-	[ return-stack-underflow. ]
+        [ callstack-underflow. ]
-	[ return-stack-overflow . ]
+        [ callstack-overflow. ]
     } dispatch ;
 
 M: no-method summary drop "No suitable method" ;

native/alien.c

@@ -24,7 +24,7 @@ void *alien_offset(CELL object)
 	case ALIEN_TYPE:
 		alien = untag_alien_fast(object);
 		if(alien->expired)
-			general_error(ERROR_EXPIRED,object);
+			general_error(ERROR_EXPIRED,object,true);
 		return alien->ptr;
 	case BYTE_ARRAY_TYPE:
 		array = untag_byte_array_fast(object);

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));
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),true);
 
 	array = allot_object(type,array_size(capacity));
 	array->capacity = tag_fixnum(capacity);

native/debug.c

@@ -257,7 +257,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);
+			general_error(ERROR_USER_INTERRUPT,F,true);
 		else if(strcmp(cmd,"q") == 0)
 			return;
 		else if(strcmp(cmd,"x") == 0)

native/dll.c

@@ -32,7 +32,7 @@ void primitive_dlsym(void)
 	{
 		d = untag_dll(dll);
 		if(d->dll == NULL)
-			general_error(ERROR_EXPIRED,dll);
+			general_error(ERROR_EXPIRED,dll,true);
 	}
 
 	dpush(tag_cell((CELL)ffi_dlsym(d,sym,true)));

native/error.c

@@ -55,19 +55,17 @@ void primitive_die(void)
 	factorbug();
 }
 
-void general_error(CELL error, CELL tagged)
+void general_error(CELL error, CELL tagged, bool keep_stacks)
 {
 	CELL thrown = cons(userenv[ERROR_ENV],cons(error,cons(tagged,F)));
-	throw_error(thrown,true);
+	throw_error(thrown,keep_stacks);
 }
 
 /* It is not safe to access 'ds' from a signal handler, so we just not
 touch it */
 void signal_error(int signal)
 {
-	throw_error(cons(userenv[ERROR_ENV],
+	general_error(ERROR_SIGNAL,tag_fixnum(signal),false);
-		cons(ERROR_SIGNAL,
-			cons(tag_fixnum(signal),F))),false);
 }
 
 /* called from signal.c when a sigv tells us that we under/overflowed a page.
@@ -76,14 +74,13 @@ void signal_error(int signal)
  * underflowed it) */
 void signal_stack_error(bool is_return_stack, bool is_overflow)
 {
-	CELL errors[] = { ERROR_STACK_UNDERFLOW, ERROR_STACK_OVERFLOW,
+	CELL errors[] = { ERROR_DS_UNDERFLOW, ERROR_DS_OVERFLOW,
-			  ERROR_RETSTACK_UNDERFLOW, ERROR_RETSTACK_OVERFLOW };
+			  ERROR_CS_UNDERFLOW, ERROR_CS_OVERFLOW };
-	const CELL error = errors[is_return_stack * 2 + is_overflow];
+	general_error(errors[is_return_stack * 2 + is_overflow],F,false);
-	throw_error(cons(userenv[ERROR_ENV], cons(error, F)), false);
 }
 
 void type_error(CELL type, CELL tagged)
 {
 	CELL c = cons(tag_fixnum(type),cons(tagged,F));
-	general_error(ERROR_TYPE,c);
+	general_error(ERROR_TYPE,c,true);
 }

native/error.h

@@ -10,10 +10,10 @@
 #define ERROR_HEAP_SCAN (9<<3)
 #define ERROR_UNDEFINED_SYMBOL (10<<3)
 #define ERROR_USER_INTERRUPT (11<<3)
-#define ERROR_STACK_UNDERFLOW (12<<3)
+#define ERROR_DS_UNDERFLOW (12<<3)
-#define ERROR_STACK_OVERFLOW (13<<3)
+#define ERROR_DS_OVERFLOW (13<<3)
-#define ERROR_RETSTACK_UNDERFLOW (14<<3)
+#define ERROR_CS_UNDERFLOW (14<<3)
-#define ERROR_RETSTACK_OVERFLOW (15<<3)
+#define ERROR_CS_OVERFLOW (15<<3)
 
 /* Are we throwing an error? */
 bool throwing;
@@ -33,8 +33,9 @@ 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);
+void general_error(CELL error, CELL tagged, 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);

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));
+		general_error(ERROR_FLOAT_FORMAT,tag_object(str),true);
 	drepl(tag_float(f));
 }
 

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);
+	general_error(ERROR_IO,error,true);
 }
 
 void primitive_fopen(void)

native/memory.c

@@ -187,7 +187,7 @@ void primitive_next_object(void)
 	CELL size, type;
 
 	if(!heap_scan)
-		general_error(ERROR_HEAP_SCAN,F);
+		general_error(ERROR_HEAP_SCAN,F,true);
 
 	if(heap_scan_ptr >= tenured.here)
 	{

native/relocate.c

@@ -87,7 +87,7 @@ void relocate_data()
 
 void undefined_symbol(void)
 {
-	general_error(ERROR_UNDEFINED_SYMBOL,F);
+	general_error(ERROR_UNDEFINED_SYMBOL,F,true);
 }
 
 CELL get_rel_symbol(F_REL* rel)

native/run.c

@@ -65,7 +65,7 @@ void run(void)
 /* XT of deferred words */
 void undefined(F_WORD* word)
 {
-	general_error(ERROR_UNDEFINED_WORD,tag_object(word));
+	general_error(ERROR_UNDEFINED_WORD,tag_object(word),true);
 }
 
 /* XT of compound definitions */

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));
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),true);
 	sbuf = allot_object(SBUF_TYPE,sizeof(F_SBUF));
 	sbuf->top = tag_fixnum(0);
 	sbuf->string = tag_object(string(capacity,'\0'));

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));
+		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),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));
+				general_error(ERROR_C_STRING,tag_object(s),true);
 		}
 	}
 

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())));
+				from_c_string(dlerror())),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())));
+				from_c_string(dlerror())),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())));
+			from_c_string(dlerror())),true);
 	}
 	dll->dll = NULL;
 }

native/unix/icache.S

@@ -1,4 +1,4 @@
-#include "platform.h"
+#include "../platform.h"
 
 /* Thanks to Joshua Grams for this code.
 

native/unix/signal.c

@@ -4,15 +4,16 @@
 // this function tests if a given faulting location is in a poison page. The
 // page address is taken from area + round_up_to_page_size(area_size) + 
 // pagesize*offset
-static bool in_page(void *fault, void *i_area, CELL area_size, int offset) {
+static bool in_page(void *fault, void *i_area, CELL area_size, int offset)
-  const int pagesize = getpagesize();
+{
-  intptr_t area = (intptr_t) i_area;
+	const int pagesize = getpagesize();
-  area += pagesize * ((area_size + (pagesize - 1)) / pagesize);
+	intptr_t area = (intptr_t) i_area;
-  area += offset * pagesize;
+	area += pagesize * ((area_size + (pagesize - 1)) / pagesize);
+	area += offset * pagesize;
 
-  const int page = area / pagesize;
+	const int page = area / pagesize;
-  const int fault_page = (intptr_t)fault / pagesize;
+	const int fault_page = (intptr_t)fault / pagesize;
-  return page == fault_page;
+	return page == fault_page;
 }
 
 void signal_handler(int signal, siginfo_t* siginfo, void* uap)
@@ -27,27 +28,14 @@ void signal_handler(int signal, siginfo_t* siginfo, void* uap)
 		fprintf(stderr,"Code space exhausted\n");
 		factorbug();
 	}
-	/* we wish to catch the case where we underflow/overflow the data or
-	// return stacks. These stacks have poison pages above and below the
-	// memory so we just need to test if the faulting addresss is in one of
-	// these pages */
-
-	/* first, underflowing the data stack */
 	else if(in_page(siginfo->si_addr, (void *) ds_bot, 0, -1))
-	{
 		signal_stack_error(false, false);
-	}
+	else if(in_page(siginfo->si_addr, (void *) ds_bot, ds_size, 0))
-	else if(in_page(siginfo->si_addr, (void *) ds_bot, ds_size, 0)) {
 		signal_stack_error(false, true);
-	}
 	else if(in_page(siginfo->si_addr, (void *) cs_bot, 0, -1))
-	{
 		signal_stack_error(true, false);
-	}
+	else if(in_page(siginfo->si_addr, (void *) cs_bot, cs_size, 0))
-	else if(in_page(siginfo->si_addr, (void *) cs_bot, cs_size, 0)) {
 		signal_stack_error(true, true);
-	}
-		
 	else
 		signal_error(signal);
 }

native/win32/ffi.c

@@ -15,7 +15,7 @@ void ffi_dlopen (DLL *dll, bool error)
 	{
 		dll->dll = NULL;
 		if(error)
-			general_error(ERROR_FFI, tag_object(get_error_message()));
+			general_error(ERROR_FFI, tag_object(get_error_message()),true);
 		else
 			return;
 	}
@@ -31,7 +31,7 @@ void *ffi_dlsym (DLL *dll, F_STRING *symbol, bool error)
 	if (!sym)
 	{
 		if(error)
-			general_error(ERROR_FFI, tag_object(get_error_message()));
+			general_error(ERROR_FFI, tag_object(get_error_message()),true);
 		else
 			return NULL;
 	}