diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index dd3a2df5c8..1eaa8cf92d 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -11,10 +11,6 @@ - files can be reloaded and edited - modules can be (re)loaded - keyboard navigation -- editor: - - more efficient multi-line inserts - - write "foo| " and put caret at | then select word element: selects - space - ui browser: show currently selected vocab & words - keyboard-navigatable list gadget of some kind - tuple= in dataflow view @@ -22,7 +18,6 @@ - ui quick start doc - auto-update browser and help when sources reload - how do we refer to command shortcuts in the docs? -- reliably clonable gadgets - figure out if we need both set-model and set-model* - if i do 10000 [ . ] each and then clear, the listener window is slow - full-height nodes should really be full height @@ -38,11 +33,11 @@ - editor should support stream output protocol - double/triple click - autoscroll - - undo and redo - transpose char/word/line - - page up/down - - search and replace - drag scroll + - more efficient multi-line inserts + - write "foo| " and put caret at | then select word element: selects + space - slider needs to be modelized - fonts/ should go inside the .app -- we need multi-tier resource-path - should be possible to drop an image file on the .app to run it @@ -50,7 +45,6 @@ - own-selection violates ICCCM - cocoa: windows are not updated while resizing - grid slows down with 2000 lines -- ui uses too much cpu time idling - see if its possible to only repaint dirty regions - x11 title bars are funny - rollover is not updated on window focus changes @@ -102,6 +96,7 @@ + misc: +- symbol redef is an xref false positive - signal 4 on datastack underflow on mac intel?? - fix alien-callback/SEH bug on win32 - minor GC takes too long now, we should card mark code heap diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 0450ba2297..79dcfb4723 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -172,6 +172,7 @@ M: f ' dup word-primitive ' , dup word-def ' , dup word-props ' , + f ' , 0 , ] { } make word-tag word-tag [ emit-seq ] emit-object diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index 7963d037ef..c8b097a437 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -99,7 +99,6 @@ call { "float>=" "math-internals" } { "(word)" "kernel-internals" } { "update-xt" "words" } - { "compiled?" "words" } { "drop" "kernel" } { "2drop" "kernel" } { "3drop" "kernel" } @@ -284,6 +283,12 @@ num-types f builtins set { "word-props" "words" } { "set-word-props" "words" } } + { + 7 + object + { "compiled?" "words" } + f + } } define-builtin "ratio?" "math" create t "inline" set-word-prop diff --git a/vm/code_gc.c b/vm/code_gc.c index 64e2d92976..d217775137 100644 --- a/vm/code_gc.c +++ b/vm/code_gc.c @@ -67,6 +67,8 @@ CELL heap_allot(HEAP *heap, CELL size) F_BLOCK *prev = NULL; F_BLOCK *scan = heap->free_list; + size = align8(size); + while(scan) { CELL this_size = scan->size - sizeof(F_BLOCK); @@ -209,20 +211,20 @@ void mark_sweep_step(F_COMPILED *compiled, CELL code_start, if(compiled->finalized) { for(scan = words_start; scan < words_end; scan += CELLS) - mark_and_sweep(get(scan)); + recursive_mark(get(scan)); } } -void mark_and_sweep(CELL xt) +void recursive_mark(CELL xt) { F_BLOCK *block = xt_to_block(xt); if(block->status == B_MARKED) return; - else if(block->status == B_FREE) - critical_error("Marking a free block",(CELL)block); - - block->status = B_MARKED; + else if(block->status == B_ALLOCATED) + block->status = B_MARKED; + else + critical_error("Marking the wrong block",(CELL)block); F_COMPILED *compiled = xt_to_compiled(xt); iterate_code_heap_step(compiled,collect_literals_step); diff --git a/vm/code_gc.h b/vm/code_gc.h index 8541f568ed..00b703cfaf 100644 --- a/vm/code_gc.h +++ b/vm/code_gc.h @@ -74,6 +74,6 @@ INLINE F_COMPILED *xt_to_compiled(CELL xt) void init_code_heap(CELL size); void iterate_code_heap(CODE_HEAP_ITERATOR iter); void collect_literals(void); -void mark_and_sweep(CELL xt); +void recursive_mark(CELL xt); void primitive_code_room(void); void primitive_code_gc(void); diff --git a/vm/compiler.c b/vm/compiler.c index bd2343d7cd..89b9168559 100644 --- a/vm/compiler.c +++ b/vm/compiler.c @@ -232,6 +232,7 @@ void primitive_finalize_compile(void) F_ARRAY *pair = untag_array(get(AREF(array,i))); F_WORD *word = untag_word(get(AREF(pair,0))); word->xt = to_cell(get(AREF(pair,1))); + word->compiledp = T; } /* perform relocation */ diff --git a/vm/data_gc.c b/vm/data_gc.c index 4ecf4dc687..5965488236 100644 --- a/vm/data_gc.c +++ b/vm/data_gc.c @@ -79,31 +79,6 @@ void primitive_size(void) drepl(tag_fixnum(object_size(dpeek()))); } -/* The number of cells from the start of the object which should be scanned by -the GC. Some types have a binary payload at the end (string, word, DLL) which -we ignore. */ -CELL binary_payload_start(CELL pointer) -{ - switch(untag_header(get(pointer))) - { - /* these objects do not refer to other objects at all */ - case STRING_TYPE: - case FLOAT_TYPE: - case BYTE_ARRAY_TYPE: - case BIGNUM_TYPE: - return 0; - /* these objects have some binary data at the end */ - case WORD_TYPE: - return sizeof(F_WORD) - CELLS; - case ALIEN_TYPE: - case DLL_TYPE: - return CELLS * 2; - /* everything else consists entirely of pointers */ - default: - return unaligned_object_size(pointer); - } -} - void primitive_data_room(void) { F_ARRAY *a = array(ARRAY_TYPE,gen_count,F); @@ -417,8 +392,37 @@ CELL copy_object(CELL pointer) return RETAG(copy_object_impl(pointer),tag); } -INLINE void collect_object(CELL scan) +/* The number of cells from the start of the object which should be scanned by +the GC. Some types have a binary payload at the end (string, word, DLL) which +we ignore. */ +CELL binary_payload_start(CELL pointer) { + switch(untag_header(get(pointer))) + { + /* these objects do not refer to other objects at all */ + case STRING_TYPE: + case FLOAT_TYPE: + case BYTE_ARRAY_TYPE: + case BIGNUM_TYPE: + return 0; + /* these objects have some binary data at the end */ + case WORD_TYPE: + return sizeof(F_WORD) - CELLS; + case ALIEN_TYPE: + case DLL_TYPE: + return CELLS * 2; + /* everything else consists entirely of pointers */ + default: + return unaligned_object_size(pointer); + } +} + +/* Every object has a regular representation in the runtime, which makes GC +much simpler. Every slot of the object until binary_payload_start is a pointer +to some other object. */ +INLINE void collect_object(CELL start) +{ + CELL scan = start; CELL payload_start = binary_payload_start(scan); CELL end = scan + payload_start; @@ -429,6 +433,16 @@ INLINE void collect_object(CELL scan) copy_handle((CELL*)scan); scan += CELLS; } + + /* It is odd to put this hook here, but this is the only special case + made for any type of object by the GC. If code GC is being performed, + compiled code blocks referenced by this word must be marked. */ + if(collecting_code && object_type(start) == WORD_TYPE) + { + F_WORD *word = (F_WORD *)start; + if(word->compiledp != F) + recursive_mark(word->xt); + } } CELL collect_next(CELL scan) @@ -487,6 +501,7 @@ void end_gc() fprintf(stderr,"*** %s GC (%ld minor, %ld cards)\n", collecting_code ? "Code and data" : "Data", minor_collections,cards_scanned); + fflush(stderr); minor_collections = 0; cards_scanned = 0; } diff --git a/vm/layouts.h b/vm/layouts.h index 74ff43a7ef..04fa715fa8 100644 --- a/vm/layouts.h +++ b/vm/layouts.h @@ -105,6 +105,11 @@ typedef struct { CELL array; } F_HASHTABLE; +/* When a word is executed we jump to the value of the XT field. However this +value is an unportable function pointer. Interpreted and primitive words will +have their XT set to a value in the 'primitives' global (see primitives.c). +Compiled words are marked as such and their XT, which point inside the code +heap, are instead relocated on startup, and also considered a code GC root. */ typedef struct { /* TAGGED header */ CELL header; @@ -120,6 +125,8 @@ typedef struct { CELL def; /* TAGGED property hash for library code */ CELL props; + /* TAGGED t or f, depending on if the word is compiled or not */ + CELL compiledp; /* UNTAGGED execution token: jump here to execute word */ CELL xt; } F_WORD; diff --git a/vm/primitives.c b/vm/primitives.c index f817bc18b1..148e9592c0 100644 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -68,7 +68,6 @@ void* primitives[] = { primitive_float_greatereq, primitive_word, primitive_update_xt, - primitive_word_compiledp, primitive_drop, primitive_2drop, primitive_3drop, diff --git a/vm/types.c b/vm/types.c index 6bc3fca734..d644e4e798 100644 --- a/vm/types.c +++ b/vm/types.c @@ -417,11 +417,9 @@ void primitive_hashtable(void) dpush(tag_object(hash)); } -/* When a word is executed we jump to the value of the xt field. However this - value is an unportable function pointer, so in the image we store a primitive - number that indexes a list of xts. */ void update_xt(F_WORD* word) { + word->compiledp = F; word->xt = primitive_to_xt(to_fixnum(word->primitive)); } @@ -442,6 +440,7 @@ void primitive_word(void) word->primitive = tag_fixnum(0); word->def = F; word->props = F; + word->compiledp = F; word->xt = (CELL)undefined; dpush(tag_word(word)); } @@ -451,23 +450,11 @@ void primitive_update_xt(void) update_xt(untag_word(dpop())); } -void primitive_word_compiledp(void) -{ - F_WORD* word = untag_word(dpop()); - if(to_fixnum(word->primitive) != 1) - box_boolean(false); - else - box_boolean(word->xt != (CELL)docol); -} - void fixup_word(F_WORD* word) { /* If this is a compiled word, relocate the code pointer. Otherwise, reset it based on the primitive number of the word. */ - if(code_relocation_base != 0 - && word->xt >= code_relocation_base - && word->xt < code_relocation_base - - compiling.base + compiling.limit) + if(word->compiledp != F) code_fixup(&word->xt); else update_xt(word); diff --git a/vm/types.h b/vm/types.h index 6be2d9cbd1..035d01efbc 100644 --- a/vm/types.h +++ b/vm/types.h @@ -161,7 +161,6 @@ INLINE CELL tag_word(F_WORD *word) void update_xt(F_WORD* word); void primitive_word(void); void primitive_update_xt(void); -void primitive_word_compiledp(void); void fixup_word(F_WORD* word); INLINE F_WRAPPER *untag_wrapper_fast(CELL tagged)