steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up AGL's patch

darcs
slava 2006-02-08 00:09:46 +00:00
parent d088a97f82
commit b861c09e9f
18 changed files with 53 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
library/tools/debugger.factor
View File

@ -48,20 +48,20 @@ SYMBOL: error-continuation
: user-interrupt. ( obj -- )
"User interrupt" print drop ;
: stack-underflow. ( obj -- )
"Stack underflow" print drop ;
: datastack-underflow. ( obj -- )
"Data stack underflow" print drop ;
: stack-overflow. ( obj -- )
"Stack overflow" print drop ;
: datastack-overflow. ( obj -- )
"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. ]
[ stack-overflow. ]
[ return-stack-underflow. ]
[ return-stack-overflow . ]
[ datastack-underflow. ]
[ datastack-overflow. ]
[ callstack-underflow. ]
[ callstack-overflow. ]
} dispatch ;
M: no-method summary drop "No suitable method" ;

2
native/alien.c
View File

@ -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);

2
native/array.c
View File

@ -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);

2
native/debug.c
View File

@ -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)

2
native/dll.c
View File

@ -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)));

17
native/error.c
View File

@ -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],
cons(ERROR_SIGNAL,
cons(tag_fixnum(signal),F))),false);
general_error(ERROR_SIGNAL,tag_fixnum(signal),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,
ERROR_RETSTACK_UNDERFLOW, ERROR_RETSTACK_OVERFLOW };
const CELL error = errors[is_return_stack * 2 + is_overflow];
throw_error(cons(userenv[ERROR_ENV], cons(error, F)), false);
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);
}
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);
}

11
native/error.h
View File

@ -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_STACK_OVERFLOW (13<<3)
#define ERROR_RETSTACK_UNDERFLOW (14<<3)
#define ERROR_RETSTACK_OVERFLOW (15<<3)
#define ERROR_DS_UNDERFLOW (12<<3)
#define ERROR_DS_OVERFLOW (13<<3)
#define ERROR_CS_UNDERFLOW (14<<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);

2
native/float.c
View File

@ -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));
}

2
native/io.c
View File

@ -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)

2
native/memory.c
View File

@ -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)
{

2
native/relocate.c
View File

@ -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)

2
native/run.c
View File

@ -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 */

2
native/sbuf.c
View File

@ -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'));

4
native/string.c
View File

@ -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);
}
}

6
native/unix/ffi.c
View File

@ -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;
}

2
native/unix/icache.S
View File

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

20
native/unix/signal.c
View File

@ -4,7 +4,8 @@
// 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;
area += pagesize * ((area_size + (pagesize - 1)) / pagesize);
@ -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);
}

4
native/win32/ffi.c
View File

@ -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;
}