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

Runtime changes to support callbacks, and other cleanups

darcs
slava 2006-02-13 07:46:07 +00:00
parent 94b2782693
commit 84d24c4440
16 changed files with 265 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
TODO.FACTOR.txt
View File

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

6
library/test/alien.factor
View File

@ -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 <alien> 0 <alien> = ] unit-test
[ f ] [ 0 <alien> 1024 <alien> = ] 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

15
native/alien.c
View File

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

7
native/array.c
View File

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

2
native/compiler.c
View File

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

5
native/error.c
View File

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

1
native/error.h
View File

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

1
native/factor.c
View File

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

33
native/gc.c
View File

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

14
native/memory.h
View File

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

45
native/run.c
View File

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

2
native/run.h
View File

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

45
native/stack.c
View File

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

22
native/stack.h
View File

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

28
native/unix/memory.c
View File

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

42
native/win32/memory.c
View File

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