From 84d24c4440f79a7f7edc6b06bc9a30bafcec0af6 Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 13 Feb 2006 07:46:07 +0000 Subject: [PATCH] Runtime changes to support callbacks, and other cleanups --- TODO.FACTOR.txt | 91 +++++++++++++++++++++++++-------------- library/test/alien.factor | 6 +-- native/alien.c | 15 +++++++ native/array.c | 7 ++- native/compiler.c | 2 +- native/error.c | 5 --- native/error.h | 1 - native/factor.c | 1 - native/gc.c | 33 +++++++++----- native/memory.h | 14 ++++-- native/run.c | 45 ++++++++++++++++--- native/run.h | 2 + native/stack.c | 45 +++++++++++++++---- native/stack.h | 22 +++++++++- native/unix/memory.c | 28 ++++++++++-- native/win32/memory.c | 42 +++++++++++------- 16 files changed, 265 insertions(+), 94 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index f6d17337c5..d94671bcdf 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,45 +1,35 @@ ++ portability: + +- port ffi to win64 +- x86 %unbox-struct +- amd64 %unbox-struct +- get factor running on mac intel + ++ io: + - if select() returns an error, fep - FILE* leaked in process.factor -- fix remaining HTML stream issues -- help cross-referencing -- UI browser pane needs 'back' button - runtime primitives like fopen: check for null input -- port ffi to win64 -- fix up the min thumb size hack -- the invalid recursion form case needs to be fixed, for inlines too -- code walker & exceptions -- signal handler should not lose stack pointers -- FIELD: char key_vector[32]; -- FIELD: union { char b[20]; short s[10]; long l[5]; } data; -- MEMBER: long pad[24]; -- C structs, enums, unions: use new-style string mode parsing -- ffi unicode strings: null char security hole -- utf16 string boxing -- [ [ dup call ] dup call ] infer hangs -- slice: if sequence or seq start is changed, abstraction violation -- out of memory error when printing global namespace -- delegating generic words with a non-standard picker - - pass an integer stack pos instead of a quotation -- code gc - stream server can hang because of exception handler limitations - better i/o scheduler - if two tasks write to a unix stream, the buffer can overflow -- make 3.4 bits>double an error -- 2220.446049250313 [ dup float? [ tanh ] when ] - - call and compile-1 give C{ 0.0/0.0 0.0/0.0 } 0.0/0.0 -- 2.718281828459045e+19 [ dup float? [ sech ] when ] - - call/compile-1: C{ 0.0/0.0 0.0/0.0 } 0.0 -- 0.0/0.0 next-power-of-2 never terminates -- comparison always returns false -- 0.0/0.0 >fixnum . -> 0 0.0/0.0 >bignum . -> 0 +- out of memory error when printing global namespace - "localhost" 50 won't fail -- out of memory from ffi calls -- out of memory from overflow check -- x86 %unbox-struct -- amd64 %unbox-struct -- remove literal table -- callbacks + ++ objective C/cocoa: + - CFBundle error handling - autoload frameworks in cocoa class words +- exceptions +- subclassing +- messages returning structs by value + ++ ui/help: + +- fix remaining HTML stream issues +- UI browser pane needs 'back' button +- fix up the min thumb size hack +- help cross-referencing - document FFI - document tools - document conventions @@ -47,6 +37,41 @@ - better line spacing in ui - use vertex arrays and display lists to speed up ui - tabular formatting + ++ compiler/ffi: + - float intrinsics - complex float type - complex float intrinsics +- out of memory from ffi calls +- out of memory from overflow check +- remove literal table +- callbacks + - zero-arity + - return-only + - input values + - value type struct inputs +- ffi unicode strings: null char security hole +- utf16 string boxing +- signal handler should not lose stack pointers +- FIELD: char key_vector[32]; +- FIELD: union { char b[20]; short s[10]; long l[5]; } data; +- MEMBER: long pad[24]; +- C structs, enums, unions: use new-style string mode parsing +- [ [ dup call ] dup call ] infer hangs +- the invalid recursion form case needs to be fixed, for inlines too +- code gc + ++ misc: + +- code walker & exceptions +- slice: if sequence or seq start is changed, abstraction violation +- delegating generic words with a non-standard picker + - pass an integer stack pos instead of a quotation +- make 3.4 bits>double an error +- 2220.446049250313 [ dup float? [ tanh ] when ] + - call and compile-1 give C{ 0.0/0.0 0.0/0.0 } 0.0/0.0 +- 2.718281828459045e+19 [ dup float? [ sech ] when ] + - call/compile-1: C{ 0.0/0.0 0.0/0.0 } 0.0 +- 0.0/0.0 next-power-of-2 never terminates -- comparison always returns false +- 0.0/0.0 >fixnum . -> 0 0.0/0.0 >bignum . -> 0 diff --git a/library/test/alien.factor b/library/test/alien.factor index 352a16881a..22824df233 100644 --- a/library/test/alien.factor +++ b/library/test/alien.factor @@ -1,5 +1,5 @@ IN: temporary -USING: alien arrays kernel kernel-internals namespaces objc test ; +USING: alien arrays kernel kernel-internals namespaces test ; [ t ] [ 0 0 = ] unit-test [ f ] [ 0 1024 = ] unit-test @@ -50,8 +50,4 @@ cell 8 = [ [ "hello world" ] [ "hello world" string>alien alien>string ] unit-test -[ "example" ] [ "{example=@*i}" parse-objc-type ] unit-test -[ "void*" ] [ "[12^f]" parse-objc-type ] unit-test -[ "void*" ] [ "^f" parse-objc-type ] unit-test - [ t ] [ f expired? ] unit-test diff --git a/native/alien.c b/native/alien.c index e1fd62cf3b..bcf545fa8a 100644 --- a/native/alien.c +++ b/native/alien.c @@ -1,5 +1,6 @@ #include "factor.h" +/* test if alien is no longer valid (it survived an image save/load) */ void primitive_expired(void) { CELL object = dpeek(); @@ -15,6 +16,7 @@ void primitive_expired(void) drepl(F); } +/* gets the address of an object representing a C pointer */ void *alien_offset(CELL object) { ALIEN *alien; @@ -42,17 +44,20 @@ void *alien_offset(CELL object) } } +/* pop ( alien n ) from datastack, return alien's address plus n */ INLINE void *alien_pointer(void) { F_FIXNUM offset = unbox_signed_cell(); return alien_offset(dpop()) + offset; } +/* pop an object representing a C pointer */ void *unbox_alien(void) { return alien_offset(dpop()); } +/* make an alien */ ALIEN *alien(void* ptr) { ALIEN* alien = allot_object(ALIEN_TYPE,sizeof(ALIEN)); @@ -61,6 +66,7 @@ ALIEN *alien(void* ptr) return alien; } +/* make an alien and push */ void box_alien(void *ptr) { if(ptr == NULL) @@ -69,6 +75,7 @@ void box_alien(void *ptr) dpush(tag_object(alien(ptr))); } +/* make an alien form an address on the stack */ void primitive_alien(void) { void* ptr = (void*)unbox_signed_cell(); @@ -76,6 +83,7 @@ void primitive_alien(void) box_alien(ptr); } +/* make an alien pointing at an offset of another alien */ void primitive_displaced_alien(void) { CELL alien; @@ -90,38 +98,45 @@ void primitive_displaced_alien(void) dpush(tag_object(d)); } +/* address of an object representing a C pointer */ void primitive_alien_address(void) { box_unsigned_cell((CELL)alien_offset(dpop())); } +/* convert C string at address to Factor string */ void primitive_alien_to_string(void) { maybe_gc(0); drepl(tag_object(from_c_string(alien_offset(dpeek())))); } +/* convert Factor string to C string allocated in the Factor heap */ void primitive_string_to_alien(void) { maybe_gc(0); drepl(tag_object(string_to_alien(untag_string(dpeek()),true))); } +/* expire aliens when loading the image */ void fixup_alien(ALIEN *alien) { alien->expired = true; } +/* image loading */ void fixup_displaced_alien(DISPLACED_ALIEN *d) { data_fixup(&d->alien); } +/* GC */ void collect_displaced_alien(DISPLACED_ALIEN *d) { copy_handle(&d->alien); } +/* define words to read/write numericals values at an alien address */ #define DEF_ALIEN_SLOT(name,type,boxer) \ void primitive_alien_##name (void) \ { \ diff --git a/native/array.c b/native/array.c index 5c579bb498..cfdc26cbce 100644 --- a/native/array.c +++ b/native/array.c @@ -14,6 +14,7 @@ F_ARRAY* allot_array(CELL type, F_FIXNUM capacity) return array; } +/* make a new array with an initial element */ F_ARRAY* array(CELL type, F_FIXNUM capacity, CELL fill) { int i; @@ -23,6 +24,7 @@ F_ARRAY* array(CELL type, F_FIXNUM capacity, CELL fill) return array; } +/* push a new array on the stack */ void primitive_array(void) { CELL initial; @@ -33,6 +35,7 @@ void primitive_array(void) dpush(tag_object(array(ARRAY_TYPE,size,initial))); } +/* push a new tuple on the stack */ void primitive_tuple(void) { F_FIXNUM size = to_fixnum(dpop()); @@ -40,6 +43,7 @@ void primitive_tuple(void) dpush(tag_object(array(TUPLE_TYPE,size,F))); } +/* push a new byte on the stack */ void primitive_byte_array(void) { F_FIXNUM size = to_fixnum(dpop()); @@ -48,7 +52,6 @@ void primitive_byte_array(void) dpush(tag_object(array(BYTE_ARRAY_TYPE,byte_size,0))); } -/* see note about fill in array() */ F_ARRAY* resize_array(F_ARRAY* array, F_FIXNUM capacity, CELL fill) { int i; @@ -95,6 +98,7 @@ void primitive_tuple_to_array(void) drepl(tuple); } +/* image loading */ void fixup_array(F_ARRAY* array) { int i = 0; CELL capacity = array_capacity(array); @@ -102,6 +106,7 @@ void fixup_array(F_ARRAY* array) data_fixup((void*)AREF(array,i)); } +/* GC */ void collect_array(F_ARRAY* array) { int i = 0; CELL capacity = array_capacity(array); diff --git a/native/compiler.c b/native/compiler.c index 27cf8155a0..2a88b152c3 100644 --- a/native/compiler.c +++ b/native/compiler.c @@ -2,7 +2,7 @@ void init_compiler(CELL size) { - compiling.base = compiling.here = (CELL)alloc_guarded(size); + compiling.base = compiling.here = (CELL)(alloc_bounded_block(size)->start); if(compiling.base == 0) fatal_error("Cannot allocate code heap",size); compiling.limit = compiling.base + size; diff --git a/native/error.c b/native/error.c index 2f9954fa06..0fbd600a4a 100644 --- a/native/error.c +++ b/native/error.c @@ -1,10 +1,5 @@ #include "factor.h" -void init_errors(void) -{ - thrown_error = F; -} - void fatal_error(char* msg, CELL tagged) { fprintf(stderr,"Fatal error: %s %ld\n",msg,tagged); diff --git a/native/error.h b/native/error.h index 34dcfb1e27..3cf63f8d96 100644 --- a/native/error.h +++ b/native/error.h @@ -28,7 +28,6 @@ CELL thrown_cs; CELL thrown_callframe; CELL thrown_executing; -void init_errors(void); void fatal_error(char* msg, CELL tagged); void critical_error(char* msg, CELL tagged); void throw_error(CELL error, bool keep_stacks); diff --git a/native/factor.c b/native/factor.c index 36a69d3d81..185420984e 100644 --- a/native/factor.c +++ b/native/factor.c @@ -15,7 +15,6 @@ void init_factor(char* image, CELL ds_size, CELL cs_size, callframe = userenv[BOOT_ENV]; init_c_io(); init_signals(); - init_errors(); userenv[CPU_ENV] = tag_object(from_c_string(FACTOR_CPU_STRING)); userenv[OS_ENV] = tag_object(from_c_string(FACTOR_OS_STRING)); userenv[GEN_ENV] = tag_fixnum(gen_count); diff --git a/native/gc.c b/native/gc.c index 9ea242973e..3d787f021d 100644 --- a/native/gc.c +++ b/native/gc.c @@ -33,10 +33,10 @@ void init_arena(CELL gens, CELL young_size, CELL aging_size) if(generations == 0) fatal_error("Cannot allocate zone head array",0); - heap_start = (CELL)alloc_guarded(total_size); + heap_start = (CELL)(alloc_bounded_block(total_size)->start); heap_end = heap_start + total_size; - cards = alloc_guarded(cards_size); + cards = malloc(cards_size); cards_end = cards + cards_size; cards_offset = (CELL)cards - (heap_start >> CARD_BITS); @@ -66,21 +66,34 @@ void collect_roots(void) { int i; CELL ptr; + STACKS *stacks; copy_handle(&T); copy_handle(&bignum_zero); copy_handle(&bignum_pos_one); copy_handle(&bignum_neg_one); - /* we can't use & here since these two are in - registers on PowerPC */ - COPY_OBJECT(callframe); - COPY_OBJECT(executing); + copy_handle(&callframe); + copy_handle(&executing); - for(ptr = ds_bot; ptr <= ds; ptr += CELLS) - copy_handle((CELL*)ptr); + save_stacks(); + stacks = stack_chain; - for(ptr = cs_bot; ptr <= cs; ptr += CELLS) - copy_handle((CELL*)ptr); + while(stacks) + { + CELL bottom = stacks->ds_region->start; + CELL top = stacks->ds; + + for(ptr = bottom; ptr <= top; ptr += CELLS) + copy_handle((CELL*)ptr); + + bottom = stacks->cs_region->start; + top = stacks->cs; + + for(ptr = bottom; ptr <= top; ptr += CELLS) + copy_handle((CELL*)ptr); + + stacks = stacks->next; + } for(i = 0; i < USER_ENV; i++) copy_handle(&userenv[i]); diff --git a/native/memory.h b/native/memory.h index a1f60e632b..fa2e7a2a64 100644 --- a/native/memory.h +++ b/native/memory.h @@ -1,3 +1,13 @@ +typedef struct { + CELL start; + CELL size; +} BOUNDED_BLOCK; + +/* set up guard pages to check for under/overflow. +size must be a multiple of the page size */ +BOUNDED_BLOCK *alloc_bounded_block(CELL size); +void dealloc_bounded_block(BOUNDED_BLOCK *block); + /* macros for reading/writing memory, useful when working around C's type system */ INLINE CELL get(CELL where) @@ -151,7 +161,3 @@ void primitive_clone(void); void primitive_begin_scan(void); void primitive_next_object(void); void primitive_end_scan(void); - -/* set up guard pages to check for under/overflow. -size must be a multiple of the page size */ -void* alloc_guarded(CELL size); diff --git a/native/run.c b/native/run.c index 961c78e306..2901dffc10 100644 --- a/native/run.c +++ b/native/run.c @@ -5,13 +5,13 @@ INLINE void execute(F_WORD* word) ((XT)(word->xt))(word); } -void run(void) +/* Called from platform_run() */ +void init_errors(void) { - CELL next; - - /* Error handling. */ + thrown_error = F; + SETJMP(toplevel); - + if(throwing) { if(thrown_keep_stacks) @@ -33,11 +33,19 @@ void run(void) call(userenv[BREAK_ENV]); throwing = false; } +} + +void run_once(void) +{ + CELL next; for(;;) { if(callframe == F) { + if(cs == cs_bot) + return; + callframe = cpop(); executing = cpop(); continue; @@ -62,6 +70,33 @@ void run(void) } } +void run(void) +{ + init_errors(); + run_once(); +} + +/* Called by compiled callbacks after nest_stacks() and boxing registers */ +void run_nullary_callback(CELL quot) +{ + call(quot); + run_once(); + unnest_stacks(); +} + +/* Called by compiled callbacks after nest_stacks() and boxing registers */ +CELL run_unary_callback(CELL quot) +{ + CELL retval; + + nest_stacks(); + call(quot); + run_once(); + retval = dpeek(); + unnest_stacks(); + return retval; +} + /* XT of deferred words */ void undefined(F_WORD* word) { diff --git a/native/run.h b/native/run.h index 44600940a6..a712c46f0d 100644 --- a/native/run.h +++ b/native/run.h @@ -79,6 +79,8 @@ INLINE void call(CELL quot) } void run(void); +void run_nullary_callback(CELL quot); +CELL run_unary_callback(CELL quot); void platform_run(void); void undefined(F_WORD *word); void docol(F_WORD *word); diff --git a/native/stack.c b/native/stack.c index 2e8fac991b..f6d341ae33 100644 --- a/native/stack.c +++ b/native/stack.c @@ -12,24 +12,53 @@ void reset_callstack(void) void fix_stacks(void) { - if(STACK_UNDERFLOW(ds,ds_bot)) + if(STACK_UNDERFLOW(ds,stack_chain->ds_region)) reset_datastack(); - else if(STACK_OVERFLOW(ds,ds_bot,ds_size)) + else if(STACK_OVERFLOW(ds,stack_chain->ds_region)) reset_datastack(); - else if(STACK_UNDERFLOW(cs,cs_bot)) + else if(STACK_UNDERFLOW(cs,stack_chain->cs_region)) reset_callstack(); - else if(STACK_OVERFLOW(cs,cs_bot,cs_size)) + else if(STACK_OVERFLOW(cs,stack_chain->cs_region)) reset_callstack(); } +/* called before entry into foreign C code */ +void save_stacks(void) +{ + stack_chain->ds = ds; + stack_chain->cs = cs; +} + +/* called on entry into a compiled callback */ +void nest_stacks(void) +{ + STACKS *new_stacks = malloc(sizeof(STACKS)); + new_stacks->ds_save = ds; + new_stacks->cs_save = cs; + new_stacks->ds_region = alloc_bounded_block(ds_size); + new_stacks->cs_region = alloc_bounded_block(cs_size); + new_stacks->next = stack_chain; + stack_chain = new_stacks; + reset_datastack(); + reset_callstack(); +} + +/* called when leaving a compiled callback */ +void unnest_stacks(void) +{ + dealloc_bounded_block(stack_chain->ds_region); + dealloc_bounded_block(stack_chain->cs_region); + ds = stack_chain->ds_save; + ds = stack_chain->cs_save; + stack_chain = stack_chain->next; +} + void init_stacks(CELL ds_size_, CELL cs_size_) { ds_size = ds_size_; cs_size = cs_size_; - ds_bot = (CELL)alloc_guarded(ds_size); - reset_datastack(); - cs_bot = (CELL)alloc_guarded(cs_size); - reset_callstack(); + stack_chain = NULL; + nest_stacks(); } void primitive_drop(void) diff --git a/native/stack.h b/native/stack.h index 034167964a..21662cbdce 100644 --- a/native/stack.h +++ b/native/stack.h @@ -1,11 +1,29 @@ +typedef struct _STACKS { + CELL ds; + CELL ds_save; + BOUNDED_BLOCK *ds_region; + CELL cs; + CELL cs_save; + BOUNDED_BLOCK *cs_region; + struct _STACKS *next; +} STACKS; + +STACKS *stack_chain; + CELL ds_size, cs_size; -#define STACK_UNDERFLOW(stack,bot) ((stack) + CELLS < UNTAG(bot)) -#define STACK_OVERFLOW(stack,bot,top) ((stack) + CELLS >= UNTAG(bot) + top) +#define ds_bot ((CELL)(stack_chain->ds_region->start)) +#define cs_bot ((CELL)(stack_chain->cs_region->start)) + +#define STACK_UNDERFLOW(stack,region) ((stack) + CELLS < (region)->start) +#define STACK_OVERFLOW(stack,region) ((stack) + CELLS >= (region)->start + (region)->size) void reset_datastack(void); void reset_callstack(void); void fix_stacks(void); +void save_stacks(void); +void nest_stacks(void); +void unnest_stacks(void); void init_stacks(CELL ds_size, CELL cs_size); void primitive_drop(void); diff --git a/native/unix/memory.c b/native/unix/memory.c index d57c37a4a4..2f3ab6c9c0 100644 --- a/native/unix/memory.c +++ b/native/unix/memory.c @@ -1,6 +1,6 @@ #include "../factor.h" -void *alloc_guarded(CELL size) +BOUNDED_BLOCK *alloc_bounded_block(CELL size) { int pagesize = getpagesize(); @@ -8,12 +8,34 @@ void *alloc_guarded(CELL size) PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANON | MAP_PRIVATE,-1,0); + if(array == NULL) + fatal_error("Cannot allocate memory region",0); + if(mprotect(array,pagesize,PROT_NONE) == -1) fatal_error("Cannot allocate low guard page",(CELL)array); if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1) fatal_error("Cannot allocate high guard page",(CELL)array); - /* return bottom of actual array */ - return array + pagesize; + BOUNDED_BLOCK *retval = malloc(sizeof(BOUNDED_BLOCK)); + if(retval == NULL) + fatal_error("Cannot allocate BOUNDED_BLOCK struct",0); + + retval->start = (CELL)(array + pagesize); + retval->size = size; + + return retval; +} + +void dealloc_bounded_block(BOUNDED_BLOCK *block) +{ + int pagesize = getpagesize(); + + int retval = munmap((void*)(block->start - pagesize), + pagesize + block->size + pagesize); + + if(!retval) + fatal_error("Failed to unmap region",0); + + free(block); } diff --git a/native/win32/memory.c b/native/win32/memory.c index 285d72de7f..b0054a6ed7 100644 --- a/native/win32/memory.c +++ b/native/win32/memory.c @@ -1,19 +1,31 @@ #include "../factor.h" -void *alloc_guarded(CELL size) +BOUNDED_BLOCK *alloc_bounded_block(CELL size) { - SYSTEM_INFO si; - char *mem; - DWORD ignore; - - GetSystemInfo(&si); - mem = (char *)VirtualAlloc(NULL, si.dwPageSize*2 + size, MEM_COMMIT, PAGE_EXECUTE_READWRITE); - - if (!VirtualProtect(mem, si.dwPageSize, PAGE_NOACCESS, &ignore)) - fatal_error("Cannot allocate low guard page", (CELL)mem); - - if (!VirtualProtect(mem+size+si.dwPageSize, si.dwPageSize, PAGE_NOACCESS, &ignore)) - fatal_error("Cannot allocate high guard page", (CELL)mem); - - return mem + si.dwPageSize; + SYSTEM_INFO si; + char *mem; + DWORD ignore; + + GetSystemInfo(&si); + mem = (char *)VirtualAlloc(NULL, si.dwPageSize*2 + size, MEM_COMMIT, PAGE_EXECUTE_READWRITE); + + if (!VirtualProtect(mem, si.dwPageSize, PAGE_NOACCESS, &ignore)) + fatal_error("Cannot allocate low guard page", (CELL)mem); + + if (!VirtualProtect(mem+size+si.dwPageSize, si.dwPageSize, PAGE_NOACCESS, &ignore)) + fatal_error("Cannot allocate high guard page", (CELL)mem); + + BOUNDED_BLOCK *retval = malloc(sizeof(BOUNDED_BLOCK)); + if(retval == NULL) + fatal_error("Cannot allocate BOUNDED_BLOCK struct",0); + + retval->start = mem + si.dwPageSize; + retval->size = size; + + return retval; +} + +void dealloc_bounded_block(BOUNDED_BLOCK *block) +{ + fatal_error("dealloc_bounded_block() not implemented on windows FIXME",0); }