diff --git a/Makefile b/Makefile index f9eb353a34..35cf7a05c4 100755 --- a/Makefile +++ b/Makefile @@ -37,6 +37,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm/bignum.o \ vm/booleans.o \ vm/byte_arrays.o \ + vm/callbacks.o \ vm/callstack.o \ vm/code_block.o \ vm/code_heap.o \ diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index dec7f92501..8196f46263 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -83,7 +83,7 @@ M: string resolve-pointer-type : parse-array-type ( name -- dims c-type ) "[" split unclip - [ [ "]" ?tail drop string>number ] map ] dip ; + [ [ "]" ?tail drop parse-word ] map ] dip ; M: string c-type ( name -- c-type ) CHAR: ] over member? [ diff --git a/basis/alien/parser/parser-tests.factor b/basis/alien/parser/parser-tests.factor index 061deb84c5..e405f49995 100644 --- a/basis/alien/parser/parser-tests.factor +++ b/basis/alien/parser/parser-tests.factor @@ -8,6 +8,8 @@ TYPEDEF: char char2 SYMBOL: not-c-type +CONSTANT: eleven 11 + [ "alien.parser.tests" use-vocab "alien.c-types" use-vocab @@ -15,6 +17,7 @@ SYMBOL: not-c-type [ int ] [ "int" parse-c-type ] unit-test [ { int 5 } ] [ "int[5]" parse-c-type ] unit-test [ { int 5 10 11 } ] [ "int[5][10][11]" parse-c-type ] unit-test + [ { int 5 10 eleven } ] [ "int[5][10][eleven]" parse-c-type ] unit-test [ void* ] [ "int*" parse-c-type ] unit-test [ void* ] [ "int**" parse-c-type ] unit-test [ void* ] [ "int***" parse-c-type ] unit-test @@ -40,4 +43,4 @@ TYPEDEF: int alien-parser-test-int ! reasonably unique name... ! after restart, we end up here "OK!" ] [ :1 ] recover -] unit-test \ No newline at end of file +] unit-test diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index d90cd71bc4..e086215e91 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -172,6 +172,8 @@ USERENV: jit-execute-jump 42 USERENV: jit-execute-call 43 USERENV: jit-declare-word 44 +USERENV: callback-stub 45 + ! PIC stubs USERENV: pic-load 47 USERENV: pic-tag 48 diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index eaa8be72f0..1bf7a00c75 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -355,16 +355,12 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ; "testing" callback-5 callback_test_1 ] unit-test -: callback-5a ( -- callback ) - "void" { } "cdecl" [ 8000000 f drop ] alien-callback ; +: callback-5b ( -- callback ) + "void" { } "cdecl" [ compact-gc ] alien-callback ; -! Hack; if we're on ARM, we probably don't have much RAM, so -! skip this test. -! cpu "arm" = [ -! [ "testing" ] [ -! "testing" callback-5a callback_test_1 -! ] unit-test -! ] unless +[ "testing" ] [ + "testing" callback-5b callback_test_1 +] unit-test : callback-6 ( -- callback ) "void" { } "cdecl" [ [ continue ] callcc0 ] alien-callback ; @@ -593,3 +589,4 @@ FUNCTION: short ffi_test_48 ( bool-field-test x ) ; FUNCTION: void this_does_not_exist ( ) ; [ this_does_not_exist ] [ { "kernel-error" 10 f f } = ] must-fail-with + diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 80c0124039..cd877cfafe 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -249,6 +249,12 @@ CONSTANT: rs-reg 14 ! fall-through on miss ] mega-lookup jit-define +[ + 0 2 LOAD32 rc-absolute-ppc-2/2 rt-xt jit-rel + 2 MTCTR + BCTR +] callback-stub jit-define + ! ! ! Sub-primitives ! Quotations and words diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index bf239a696d..f9a44b5ffb 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -715,7 +715,9 @@ M: ppc %box-small-struct ( c-type -- ) 3 3 0 LWZ ; M: ppc %nest-stacks ( -- ) - 3 %load-vm-addr + ! Save current frame. See comment in vm/contexts.hpp + 3 1 stack-frame get total-size>> 2 cells - ADDI + 4 %load-vm-addr "nest_stacks" f %alien-invoke ; M: ppc %unnest-stacks ( -- ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 60d2a42c01..ce73b4961e 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -120,11 +120,9 @@ M: x86.32 %save-param-reg 3drop ; #! parameter being passed to a callback from C. over [ load-return-reg ] [ 2drop ] if ; -CONSTANT: vm-ptr-size 4 - M:: x86.32 %box ( n rep func -- ) n rep (%box) - rep rep-size vm-ptr-size + [ + rep rep-size cell + [ push-vm-ptr rep push-return-reg func f %alien-invoke @@ -138,7 +136,7 @@ M:: x86.32 %box ( n rep func -- ) M: x86.32 %box-long-long ( n func -- ) [ (%box-long-long) ] dip - 8 vm-ptr-size + [ + 12 [ push-vm-ptr EDX PUSH EAX PUSH @@ -148,7 +146,7 @@ M: x86.32 %box-long-long ( n func -- ) M:: x86.32 %box-large-struct ( n c-type -- ) ! Compute destination address EDX n struct-return@ LEA - 8 vm-ptr-size + [ + 12 [ push-vm-ptr ! Push struct size c-type heap-size PUSH @@ -166,7 +164,7 @@ M: x86.32 %prepare-box-struct ( -- ) M: x86.32 %box-small-struct ( c-type -- ) #! Box a <= 8-byte struct returned in EAX:EDX. OS X only. - 12 vm-ptr-size + [ + 16 [ push-vm-ptr heap-size PUSH EDX PUSH @@ -208,7 +206,7 @@ M: x86.32 %unbox-long-long ( n func -- ) : %unbox-struct-1 ( -- ) #! Alien must be in EAX. - 4 vm-ptr-size + [ + 8 [ push-vm-ptr EAX PUSH "alien_offset" f %alien-invoke @@ -218,7 +216,7 @@ M: x86.32 %unbox-long-long ( n func -- ) : %unbox-struct-2 ( -- ) #! Alien must be in EAX. - 4 vm-ptr-size + [ + 8 [ push-vm-ptr EAX PUSH "alien_offset" f %alien-invoke @@ -239,7 +237,7 @@ M:: x86.32 %unbox-large-struct ( n c-type -- ) ! Alien must be in EAX. ! Compute destination address EDX n stack@ LEA - 12 vm-ptr-size + [ + 16 [ push-vm-ptr ! Push struct size c-type heap-size PUSH @@ -252,8 +250,11 @@ M:: x86.32 %unbox-large-struct ( n c-type -- ) ] with-aligned-stack ; M: x86.32 %nest-stacks ( -- ) - 4 [ + 8 [ push-vm-ptr + ! Save current frame. See comment in vm/contexts.hpp + EAX stack-reg stack-frame get total-size>> [+] LEA + EAX PUSH "nest_stacks" f %alien-invoke ] with-aligned-stack ; diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index 0540ccd6d6..c5f6975d33 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -17,6 +17,7 @@ IN: bootstrap.x86 : temp1 ( -- reg ) EDX ; : temp2 ( -- reg ) ECX ; : temp3 ( -- reg ) EBX ; +: safe-reg ( -- reg ) EAX ; : stack-reg ( -- reg ) ESP ; : ds-reg ( -- reg ) ESI ; : rs-reg ( -- reg ) EDI ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index e2cd5c1972..c34530c307 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -194,7 +194,9 @@ M: x86.64 %alien-invoke R11 CALL ; M: x86.64 %nest-stacks ( -- ) - param-reg-1 %mov-vm-ptr + ! Save current frame. See comment in vm/contexts.hpp + param-reg-1 stack-reg stack-frame get total-size>> 3 cells - [+] LEA + param-reg-2 %mov-vm-ptr "nest_stacks" f %alien-invoke ; M: x86.64 %unnest-stacks ( -- ) diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index e26e804232..b42a38b2d2 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -14,6 +14,7 @@ IN: bootstrap.x86 : temp1 ( -- reg ) RSI ; : temp2 ( -- reg ) RDX ; : temp3 ( -- reg ) RBX ; +: safe-reg ( -- reg ) RAX ; : stack-reg ( -- reg ) RSP ; : ds-reg ( -- reg ) R14 ; : rs-reg ( -- reg ) R15 ; diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index eb4da296dc..fb94445f78 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -243,6 +243,11 @@ big-endian off ! fall-through on miss ] mega-lookup jit-define +[ + safe-reg 0 MOV rc-absolute-cell rt-xt jit-rel + safe-reg JMP +] callback-stub jit-define + ! ! ! Sub-primitives ! Quotations and words diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index 3d150adf91..2a20ba74cd 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -1,8 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences accessors combinators math namespaces -init sets words alien.libraries -alien alien.c-types +init sets words assocs alien.libraries alien alien.c-types stack-checker.backend stack-checker.errors stack-checker.visitor ; IN: stack-checker.alien @@ -58,11 +57,11 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; ! Quotation which coerces return value to required type return-prep-quot infer-quot-here ; -: register-callback ( word -- ) callbacks get conjoin ; +: callback-xt ( word -- alien ) + callbacks get [ ] cache ; : callback-bottom ( params -- ) - xt>> [ [ register-callback ] [ word-xt drop ] bi ] curry - infer-quot-here ; + xt>> [ callback-xt ] curry infer-quot-here ; : infer-alien-callback ( -- ) alien-callback-params new @@ -70,6 +69,6 @@ TUPLE: alien-callback-params < alien-node-params quot xt ; pop-literal nip >>abi pop-literal nip >>parameters pop-literal nip >>return - gensym >>xt + "( callback )" f >>xt dup callback-bottom #alien-callback, ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index e5d8f6231c..8cddac5a75 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -495,8 +495,12 @@ M: bad-executable summary \ (exists?) { string } { object } define-primitive +\ minor-gc { } { } define-primitive + \ gc { } { } define-primitive +\ compact-gc { } { } define-primitive + \ gc-stats { } { array } define-primitive \ (save-image) { byte-array } { } define-primitive @@ -711,3 +715,7 @@ M: bad-executable summary \ inline-cache-stats { } { array } define-primitive \ optimized? { word } { object } define-primitive + +\ strip-stack-traces { } { } define-primitive + +\ { word } { alien } define-primitive diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 3f91b7102f..9fb9c042ee 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -175,13 +175,6 @@ HELP: alien-invoke-error } } ; -ARTICLE: "alien-callback-gc" "Callbacks and code GC" -"A callback consits of two parts; the callback word, which pushes the address of the callback on the stack when executed, and the callback body itself. If the callback word is redefined, removed from the dictionary using " { $link forget } ", or recompiled, the callback body will not be reclaimed by the garbage collector, since potentially C code may be holding a reference to the callback body." -$nl -"This is the safest approach, however it can lead to code heap leaks when repeatedly reloading code which defines callbacks. If you are " { $emphasis "completely sure" } " that no running C code is holding a reference to any callbacks, you can blow them all away:" -{ $code "USE: alien callbacks get clear-hash gc" } -"This will reclaim all callback bodies which are otherwise unreachable from the dictionary (that is, their associated callback words have since been redefined, recompiled or forgotten)." ; - ARTICLE: "alien-callback" "Calling Factor from C" "Callbacks can be defined and passed to C code as function pointers; the C code can then invoke the callback and run Factor code:" { $subsections @@ -189,7 +182,6 @@ ARTICLE: "alien-callback" "Calling Factor from C" POSTPONE: CALLBACK: } "There are some caveats concerning the conversion of Factor objects to C values, and vice versa. See " { $link "c-data" } "." -{ $subsections "alien-callback-gc" } { $see-also "byte-arrays-gc" } ; ARTICLE: "alien-globals" "Accessing C global variables" diff --git a/core/alien/alien.factor b/core/alien/alien.factor index d98ea3d103..3f2b5f95bf 100644 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -66,8 +66,10 @@ ERROR: alien-invoke-error library symbol ; : alien-invoke ( ... return library function parameters -- ... ) 2over alien-invoke-error ; -! Callbacks are registered in a global hashtable. If you clear -! this hashtable, they will all be blown away by code GC, beware. +! Callbacks are registered in a global hashtable. Note that they +! are also pinned in a special callback area, so clearing this +! hashtable will not reclaim callbacks. It should only be +! cleared on startup. SYMBOL: callbacks [ H{ } clone callbacks set-global ] "alien" add-init-hook diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 23da40d2c5..ef66cc3cd6 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -420,7 +420,9 @@ tuple { "getenv" "kernel.private" (( n -- obj )) } { "setenv" "kernel.private" (( obj n -- )) } { "(exists?)" "io.files.private" (( path -- ? )) } + { "minor-gc" "memory" (( -- )) } { "gc" "memory" (( -- )) } + { "compact-gc" "memory" (( -- )) } { "gc-stats" "memory" f } { "(save-image)" "memory.private" (( path -- )) } { "(save-image-and-exit)" "memory.private" (( path -- )) } @@ -523,6 +525,7 @@ tuple { "quot-compiled?" "quotations" (( quot -- ? )) } { "vm-ptr" "vm" (( -- ptr )) } { "strip-stack-traces" "kernel.private" (( -- )) } + { "" "alien" (( word -- alien )) } } [ [ first3 ] dip swap make-primitive ] each-index ! Bump build number diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index edaeb21a4c..7e94d71c29 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -140,12 +140,20 @@ HELP: no-word { $values { "name" string } { "newword" word } } { $description "Throws a " { $link no-word-error } "." } ; +HELP: parse-word +{ $values { "string" string } { "word/number" "a word or number" } } +{ $description "If " { $snippet "string" } " is a valid number literal, it is converted to a number, otherwise the current vocabulary search path is searched for a word named by the string." } +{ $errors "Throws an error if the token does not name a word, and does not parse as a number." } +{ $notes "This word is used to implement " { $link scan-word } "." } ; + HELP: scan-word { $values { "word/number/f" "a word, number or " { $link f } } } -{ $description "Reads the next token from parser input. If the token is a valid number literal, it is converted to a number, otherwise the dictionary is searched for a word named by the token. Outputs " { $link f } " if the end of the input has been reached." } +{ $description "Reads the next token from parser input. If the token is a valid number literal, it is converted to a number, otherwise the vocabulary search path is searched for a word named by the token. Outputs " { $link f } " if the end of the input has been reached." } { $errors "Throws an error if the token does not name a word, and does not parse as a number." } $parsing-note ; +{ scan-word parse-word } related-words + HELP: parse-step { $values { "accum" vector } { "end" word } { "?" "a boolean" } } { $description "Parses a token. If the token is a number or an ordinary word, it is added to the accumulator. If it is a parsing word, calls the parsing word with the accumulator on the stack. Outputs " { $link f } " if " { $snippet "end" } " is encountered, " { $link t } " otherwise." } diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 276030d770..3152afc093 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -40,12 +40,13 @@ SYMBOL: auto-use? [ throw-restarts no-word-restarted ] if ; +: parse-word ( string -- word/number ) + dup search [ ] [ + dup string>number [ ] [ no-word ] ?if + ] ?if ; + : scan-word ( -- word/number/f ) - scan dup [ - dup search [ ] [ - dup string>number [ ] [ no-word ] ?if - ] ?if - ] when ; + scan dup [ parse-word ] when ; ERROR: staging-violation word ; diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor index e6845d1847..eb47d3675c 100644 --- a/extra/alien/data/map/map-tests.factor +++ b/extra/alien/data/map/map-tests.factor @@ -92,9 +92,11 @@ IN: alien.data.map.tests : vmerge-transpose ( a b c d -- ac bd ac bd ) [ (vmerge) ] bi-curry@ bi* ; inline +CONSTANT: plane-count 4 + : fold-rgba-planes ( r g b a -- rgba ) [ vmerge-transpose vmerge-transpose ] - data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[4] ) ; + data-map( uchar-16 uchar-16 uchar-16 uchar-16 -- uchar-16[plane-count] ) ; [ B{ diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor index d4c24ef18f..48fcbcd97b 100644 --- a/extra/alien/data/map/map.factor +++ b/extra/alien/data/map/map.factor @@ -2,6 +2,7 @@ USING: accessors alien alien.c-types alien.data alien.parser arrays byte-arrays combinators effects.parser fry generalizations kernel lexer locals macros make math math.ranges parser sequences sequences.private ; +FROM: alien.arrays => array-length ; IN: alien.data.map ERROR: bad-data-map-input-length byte-length iter-size remainder ; @@ -36,7 +37,7 @@ M: data-map-param nth-unsafe INSTANCE: data-map-param immutable-sequence : c-type-count ( in/out -- c-type count iter-length ) - dup array? [ unclip swap product >fixnum ] [ 1 ] if + dup array? [ unclip swap array-length >fixnum ] [ 1 ] if 2dup swap heap-size * >fixnum ; inline MACRO: >param ( in -- quot: ( array -- param ) ) diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp new file mode 100644 index 0000000000..2401800a9a --- /dev/null +++ b/vm/callbacks.cpp @@ -0,0 +1,66 @@ +#include "master.hpp" + +namespace factor +{ + +callback_heap::callback_heap(cell size, factor_vm *myvm_) : + seg(new segment(size,true)), + here(seg->start), + myvm(myvm_) {} + +callback_heap::~callback_heap() +{ + delete seg; + seg = NULL; +} + +void factor_vm::init_callbacks(cell size) +{ + callbacks = new callback_heap(size,this); +} + +void callback_heap::update(callback *stub) +{ + tagged code_template(myvm->userenv[CALLBACK_STUB]); + + cell rel_class = untag_fixnum(array_nth(code_template.untagged(),1)); + cell offset = untag_fixnum(array_nth(code_template.untagged(),3)); + + myvm->store_address_in_code_block(rel_class, + (cell)(stub + 1) + offset, + (cell)(stub->compiled + 1)); + + flush_icache((cell)stub,stub->size); +} + +callback *callback_heap::add(code_block *compiled) +{ + tagged code_template(myvm->userenv[CALLBACK_STUB]); + tagged insns(array_nth(code_template.untagged(),0)); + cell size = array_capacity(insns.untagged()); + + cell bump = align8(size) + sizeof(callback); + if(here + bump > seg->end) fatal_error("Out of callback space",0); + + callback *stub = (callback *)here; + stub->compiled = compiled; + memcpy(stub + 1,insns->data(),size); + + stub->size = align8(size); + here += bump; + + update(stub); + + return stub; +} + +void factor_vm::primitive_callback() +{ + tagged w(dpop()); + w.untag_check(this); + + callback *stub = callbacks->add(w->code); + box_alien(stub + 1); +} + +} diff --git a/vm/callbacks.hpp b/vm/callbacks.hpp new file mode 100644 index 0000000000..571c7713c7 --- /dev/null +++ b/vm/callbacks.hpp @@ -0,0 +1,38 @@ +namespace factor +{ + +struct callback { + cell size; + code_block *compiled; + void *code() { return (void *)(this + 1); } +}; + +struct callback_heap { + segment *seg; + cell here; + factor_vm *myvm; + + explicit callback_heap(cell size, factor_vm *myvm); + ~callback_heap(); + + callback *add(code_block *compiled); + void update(callback *stub); + + callback *next(callback *stub) + { + return (callback *)((cell)stub + stub->size + sizeof(callback)); + } + + template void iterate(Iterator &iter) + { + callback *scan = (callback *)seg->start; + callback *end = (callback *)here; + while(scan < end) + { + iter(scan); + scan = next(scan); + } + } +}; + +} diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 3d752913c7..0b7663e513 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -37,19 +37,16 @@ called by continuation implementation, and user code shouldn't be calling it at all, so we leave it as it is for now. */ stack_frame *factor_vm::capture_start() { - stack_frame *frame = stack_chain->callstack_bottom - 1; - while(frame >= stack_chain->callstack_top - && frame_successor(frame) >= stack_chain->callstack_top) - { + stack_frame *frame = ctx->callstack_bottom - 1; + while(frame >= ctx->callstack_top && frame_successor(frame) >= ctx->callstack_top) frame = frame_successor(frame); - } return frame + 1; } void factor_vm::primitive_callstack() { stack_frame *top = capture_start(); - stack_frame *bottom = stack_chain->callstack_bottom; + stack_frame *bottom = ctx->callstack_bottom; fixnum size = (cell)bottom - (cell)top; if(size < 0) @@ -64,7 +61,7 @@ void factor_vm::primitive_set_callstack() { callstack *stack = untag_check(dpop()); - set_callstack(stack_chain->callstack_bottom, + set_callstack(ctx->callstack_bottom, stack->top(), untag_fixnum(stack->length), memcpy); @@ -204,7 +201,7 @@ void factor_vm::primitive_set_innermost_stack_frame_quot() /* called before entry into Factor code. */ void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom) { - stack_chain->callstack_bottom = callstack_bottom; + ctx->callstack_bottom = callstack_bottom; } VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *myvm) diff --git a/vm/code_block.cpp b/vm/code_block.cpp index 8099d09e2d..0afd98dd0f 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -39,7 +39,7 @@ int factor_vm::number_of_parameters(relocation_type type) case RT_DLSYM: return 2; case RT_THIS: - case RT_STACK_CHAIN: + case RT_CONTEXT: case RT_MEGAMORPHIC_CACHE_HITS: case RT_CARDS_OFFSET: case RT_DECKS_OFFSET: @@ -174,8 +174,8 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block } case RT_THIS: return (cell)(compiled + 1); - case RT_STACK_CHAIN: - return (cell)&stack_chain; + case RT_CONTEXT: + return (cell)&ctx; case RT_UNTAGGED: return untag_fixnum(ARG); case RT_MEGAMORPHIC_CACHE_HITS: @@ -315,8 +315,8 @@ void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_ #endif store_address_in_code_block(relocation_class_of(rel), - relocation_offset_of(rel) + (cell)compiled->xt(), - compute_relocation(rel,index,compiled)); + relocation_offset_of(rel) + (cell)compiled->xt(), + compute_relocation(rel,index,compiled)); } struct word_references_updater { @@ -441,10 +441,14 @@ code_block *factor_vm::allot_code_block(cell size, cell type) { heap_block *block = code->heap_allot(size + sizeof(code_block),type); - /* If allocation failed, do a code GC */ + /* If allocation failed, do a full GC and compact the code heap. + A full GC that occurs as a result of the data heap filling up does not + trigger a compaction. This setup ensures that most GCs do not compact + the code heap, but if the code fills up, it probably means it will be + fragmented after GC anyway, so its best to compact. */ if(block == NULL) { - primitive_full_gc(); + primitive_compact_gc(); block = code->heap_allot(size + sizeof(code_block),type); /* Insufficient room even after code GC, give up */ diff --git a/vm/code_block.hpp b/vm/code_block.hpp index e3d392001b..d31a776c0e 100644 --- a/vm/code_block.hpp +++ b/vm/code_block.hpp @@ -20,8 +20,8 @@ enum relocation_type { RT_THIS, /* immediate literal */ RT_IMMEDIATE, - /* address of stack_chain var */ - RT_STACK_CHAIN, + /* address of ctx var */ + RT_CONTEXT, /* untagged fixnum literal */ RT_UNTAGGED, /* address of megamorphic_cache_hits var */ diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index d60ec189cd..b7307dd7e6 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -208,14 +208,28 @@ void factor_vm::forward_object_xts() void factor_vm::forward_context_xts() { - context *ctx = stack_chain; + callframe_forwarder forwarder(this); + iterate_active_frames(forwarder); +} - while(ctx) +struct callback_forwarder { + code_heap *code; + callback_heap *callbacks; + + callback_forwarder(code_heap *code_, callback_heap *callbacks_) : + code(code_), callbacks(callbacks_) {} + + void operator()(callback *stub) { - callframe_forwarder forwarder(this); - iterate_callstack(ctx,forwarder); - ctx = ctx->next; + stub->compiled = code->forward_code_block(stub->compiled); + callbacks->update(stub); } +}; + +void factor_vm::forward_callback_xts() +{ + callback_forwarder forwarder(code,callbacks); + callbacks->iterate(forwarder); } /* Move all free space to the end of the code heap. Live blocks must be marked @@ -225,7 +239,11 @@ void factor_vm::compact_code_heap(bool trace_contexts_p) { code->compact_heap(); forward_object_xts(); - if(trace_contexts_p) forward_context_xts(); + if(trace_contexts_p) + { + forward_context_xts(); + forward_callback_xts(); + } } struct stack_trace_stripper { diff --git a/vm/collector.hpp b/vm/collector.hpp index c70c5073e2..8156fd1693 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -132,7 +132,7 @@ template struct collector { void trace_contexts() { - context *ctx = myvm->stack_chain; + context *ctx = myvm->ctx; while(ctx) { diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 050f4b3db6..bed044250e 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -25,10 +25,10 @@ void factor_vm::fix_stacks() be stored in registers, so callbacks must save and restore the correct values */ void factor_vm::save_stacks() { - if(stack_chain) + if(ctx) { - stack_chain->datastack = ds; - stack_chain->retainstack = rs; + ctx->datastack = ds; + ctx->retainstack = rs; } } @@ -58,12 +58,12 @@ void factor_vm::dealloc_context(context *old_context) } /* called on entry into a compiled callback */ -void factor_vm::nest_stacks() +void factor_vm::nest_stacks(stack_frame *magic_frame) { - context *new_context = alloc_context(); + context *new_ctx = alloc_context(); - new_context->callstack_bottom = (stack_frame *)-1; - new_context->callstack_top = (stack_frame *)-1; + new_ctx->callstack_bottom = (stack_frame *)-1; + new_ctx->callstack_top = (stack_frame *)-1; /* note that these register values are not necessarily valid stack pointers. they are merely saved non-volatile registers, and are @@ -75,37 +75,39 @@ void factor_vm::nest_stacks() - Factor callback returns - C function restores registers - C function returns to Factor code */ - new_context->datastack_save = ds; - new_context->retainstack_save = rs; + new_ctx->datastack_save = ds; + new_ctx->retainstack_save = rs; + + new_ctx->magic_frame = magic_frame; /* save per-callback userenv */ - new_context->current_callback_save = userenv[CURRENT_CALLBACK_ENV]; - new_context->catchstack_save = userenv[CATCHSTACK_ENV]; + new_ctx->current_callback_save = userenv[CURRENT_CALLBACK_ENV]; + new_ctx->catchstack_save = userenv[CATCHSTACK_ENV]; - new_context->next = stack_chain; - stack_chain = new_context; + new_ctx->next = ctx; + ctx = new_ctx; reset_datastack(); reset_retainstack(); } -void nest_stacks(factor_vm *myvm) +void nest_stacks(stack_frame *magic_frame, factor_vm *myvm) { - return myvm->nest_stacks(); + return myvm->nest_stacks(magic_frame); } /* called when leaving a compiled callback */ void factor_vm::unnest_stacks() { - ds = stack_chain->datastack_save; - rs = stack_chain->retainstack_save; + ds = ctx->datastack_save; + rs = ctx->retainstack_save; /* restore per-callback userenv */ - userenv[CURRENT_CALLBACK_ENV] = stack_chain->current_callback_save; - userenv[CATCHSTACK_ENV] = stack_chain->catchstack_save; + userenv[CURRENT_CALLBACK_ENV] = ctx->current_callback_save; + userenv[CATCHSTACK_ENV] = ctx->catchstack_save; - context *old_ctx = stack_chain; - stack_chain = old_ctx->next; + context *old_ctx = ctx; + ctx = old_ctx->next; dealloc_context(old_ctx); } @@ -119,7 +121,7 @@ void factor_vm::init_stacks(cell ds_size_, cell rs_size_) { ds_size = ds_size_; rs_size = rs_size_; - stack_chain = NULL; + ctx = NULL; unused_contexts = NULL; } diff --git a/vm/contexts.hpp b/vm/contexts.hpp index ea70a7ba6f..f66b5d0fe2 100644 --- a/vm/contexts.hpp +++ b/vm/contexts.hpp @@ -23,6 +23,18 @@ struct context { /* saved contents of rs register on entry to callback */ cell retainstack_save; + /* callback-bottom stack frame, or NULL for top-level context. + When nest_stacks() is called, callstack layout with callbacks + is as follows: + + [ C function ] + [ callback stub in code heap ] <-- this is the magic frame + [ native frame: c_to_factor() ] + [ callback quotation frame ] <-- first call frame in call stack + + magic frame is retained so that it's XT can be traced and forwarded. */ + stack_frame *magic_frame; + /* memory region holding current datastack */ segment *datastack_region; @@ -36,15 +48,15 @@ struct context { context *next; }; -#define ds_bot (stack_chain->datastack_region->start) -#define ds_top (stack_chain->datastack_region->end) -#define rs_bot (stack_chain->retainstack_region->start) -#define rs_top (stack_chain->retainstack_region->end) +#define ds_bot (ctx->datastack_region->start) +#define ds_top (ctx->datastack_region->end) +#define rs_bot (ctx->retainstack_region->start) +#define rs_top (ctx->retainstack_region->end) DEFPUSHPOP(d,ds) DEFPUSHPOP(r,rs) -VM_C_API void nest_stacks(factor_vm *vm); +VM_C_API void nest_stacks(stack_frame *magic_frame, factor_vm *vm); VM_C_API void unnest_stacks(factor_vm *vm); } diff --git a/vm/debug.cpp b/vm/debug.cpp index 0f8c310e06..da8c603254 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -190,7 +190,7 @@ void factor_vm::print_callstack() { print_string("==== CALL STACK:\n"); stack_frame_printer printer(this); - iterate_callstack(stack_chain,printer); + iterate_callstack(ctx,printer); } void factor_vm::dump_cell(cell x) diff --git a/vm/errors.cpp b/vm/errors.cpp index 0ea3589eec..a3c0242d7e 100755 --- a/vm/errors.cpp +++ b/vm/errors.cpp @@ -49,12 +49,9 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top) actual stack pointer at the time, since the saved pointer is not necessarily up to date at that point. */ if(callstack_top) - { - callstack_top = fix_callstack_top(callstack_top, - stack_chain->callstack_bottom); - } + callstack_top = fix_callstack_top(callstack_top,ctx->callstack_bottom); else - callstack_top = stack_chain->callstack_top; + callstack_top = ctx->callstack_top; throw_impl(userenv[BREAK_ENV],callstack_top,this); } @@ -130,7 +127,7 @@ void factor_vm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_calls void factor_vm::primitive_call_clear() { - throw_impl(dpop(),stack_chain->callstack_bottom,this); + throw_impl(dpop(),ctx->callstack_bottom,this); } /* For testing purposes */ diff --git a/vm/factor.cpp b/vm/factor.cpp index 9a26cacf1a..8b1202ddb0 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -39,6 +39,7 @@ void factor_vm::default_parameters(vm_parameters *p) p->secure_gc = false; p->fep = false; + p->signals = true; #ifdef WINDOWS p->console = false; @@ -49,6 +50,8 @@ void factor_vm::default_parameters(vm_parameters *p) p->console = false; #endif + + p->callback_size = 256; } bool factor_vm::factor_arg(const vm_char* str, const vm_char* arg, cell* value) @@ -72,17 +75,21 @@ void factor_vm::init_parameters_from_args(vm_parameters *p, int argc, vm_char ** for(i = 1; i < argc; i++) { - if(factor_arg(argv[i],STRING_LITERAL("-datastack=%d"),&p->ds_size)); - else if(factor_arg(argv[i],STRING_LITERAL("-retainstack=%d"),&p->rs_size)); - else if(factor_arg(argv[i],STRING_LITERAL("-young=%d"),&p->young_size)); - else if(factor_arg(argv[i],STRING_LITERAL("-aging=%d"),&p->aging_size)); - else if(factor_arg(argv[i],STRING_LITERAL("-tenured=%d"),&p->tenured_size)); - else if(factor_arg(argv[i],STRING_LITERAL("-codeheap=%d"),&p->code_size)); - else if(factor_arg(argv[i],STRING_LITERAL("-pic=%d"),&p->max_pic_size)); - else if(STRCMP(argv[i],STRING_LITERAL("-securegc")) == 0) p->secure_gc = true; - else if(STRCMP(argv[i],STRING_LITERAL("-fep")) == 0) p->fep = true; - else if(STRNCMP(argv[i],STRING_LITERAL("-i="),3) == 0) p->image_path = argv[i] + 3; - else if(STRCMP(argv[i],STRING_LITERAL("-console")) == 0) p->console = true; + vm_char *arg = argv[i]; + if(STRCMP(arg,STRING_LITERAL("--")) == 0) break; + else if(factor_arg(arg,STRING_LITERAL("-datastack=%d"),&p->ds_size)); + else if(factor_arg(arg,STRING_LITERAL("-retainstack=%d"),&p->rs_size)); + else if(factor_arg(arg,STRING_LITERAL("-young=%d"),&p->young_size)); + else if(factor_arg(arg,STRING_LITERAL("-aging=%d"),&p->aging_size)); + else if(factor_arg(arg,STRING_LITERAL("-tenured=%d"),&p->tenured_size)); + else if(factor_arg(arg,STRING_LITERAL("-codeheap=%d"),&p->code_size)); + else if(factor_arg(arg,STRING_LITERAL("-pic=%d"),&p->max_pic_size)); + else if(factor_arg(arg,STRING_LITERAL("-callbacks=%d"),&p->callback_size)); + else if(STRCMP(arg,STRING_LITERAL("-securegc")) == 0) p->secure_gc = true; + else if(STRCMP(arg,STRING_LITERAL("-fep")) == 0) p->fep = true; + else if(STRCMP(arg,STRING_LITERAL("-nosignals")) == 0) p->signals = false; + else if(STRNCMP(arg,STRING_LITERAL("-i="),3) == 0) p->image_path = arg + 3; + else if(STRCMP(arg,STRING_LITERAL("-console")) == 0) p->console = true; } } @@ -104,6 +111,7 @@ void factor_vm::init_factor(vm_parameters *p) /* Kilobytes */ p->ds_size = align_page(p->ds_size << 10); p->rs_size = align_page(p->rs_size << 10); + p->callback_size = align_page(p->callback_size << 10); /* Megabytes */ p->young_size <<= 20; @@ -128,10 +136,12 @@ void factor_vm::init_factor(vm_parameters *p) srand(current_micros()); init_ffi(); init_stacks(p->ds_size,p->rs_size); + init_callbacks(p->callback_size); load_image(p); init_c_io(); init_inline_caching(p->max_pic_size); - init_signals(); + if(p->signals) + init_signals(); if(p->console) open_console(); @@ -170,7 +180,7 @@ void factor_vm::start_factor(vm_parameters *p) { if(p->fep) factorbug(); - nest_stacks(); + nest_stacks(NULL); c_to_factor_toplevel(userenv[BOOT_ENV]); unnest_stacks(); } diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp index e5c95b3d79..86f3216e9c 100644 --- a/vm/full_collector.cpp +++ b/vm/full_collector.cpp @@ -26,14 +26,8 @@ struct stack_frame_marker { /* Mark code blocks executing in currently active stack frames. */ void full_collector::mark_active_blocks() { - context *ctx = this->myvm->stack_chain; - - while(ctx) - { - stack_frame_marker marker(this); - myvm->iterate_callstack(ctx,marker); - ctx = ctx->next; - } + stack_frame_marker marker(this); + myvm->iterate_active_frames(marker); } void full_collector::mark_object_code_block(object *obj) @@ -66,6 +60,23 @@ void full_collector::mark_object_code_block(object *obj) } } +struct callback_tracer { + full_collector *collector; + + callback_tracer(full_collector *collector_) : collector(collector_) {} + + void operator()(callback *stub) + { + collector->mark_code_block(stub->compiled); + } +}; + +void full_collector::trace_callbacks() +{ + callback_tracer tracer(this); + myvm->callbacks->iterate(tracer); +} + /* Trace all literals referenced from a code block. Only for aging and nursery collections */ void full_collector::trace_literal_references(code_block *compiled) { @@ -95,10 +106,10 @@ void full_collector::cheneys_algorithm() /* After growing the heap, we have to perform a full relocation to update references to card and deck arrays. */ -struct after_growing_heap_updater { +struct big_code_heap_updater { factor_vm *myvm; - after_growing_heap_updater(factor_vm *myvm_) : myvm(myvm_) {} + big_code_heap_updater(factor_vm *myvm_) : myvm(myvm_) {} void operator()(heap_block *block) { @@ -108,10 +119,10 @@ struct after_growing_heap_updater { /* After a full GC that did not grow the heap, we have to update references to literals and other words. */ -struct after_full_updater { +struct small_code_heap_updater { factor_vm *myvm; - after_full_updater(factor_vm *myvm_) : myvm(myvm_) {} + small_code_heap_updater(factor_vm *myvm_) : myvm(myvm_) {} void operator()(heap_block *block) { @@ -128,6 +139,7 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) { collector.trace_contexts(); collector.mark_active_blocks(); + collector.trace_callbacks(); } collector.cheneys_algorithm(); @@ -139,6 +151,13 @@ void factor_vm::collect_full_impl(bool trace_contexts_p) /* In both cases, compact code heap before updating code blocks so that XTs are correct after */ +void factor_vm::big_code_heap_update() +{ + big_code_heap_updater updater(this); + code->free_unmarked(updater); + code->clear_remembered_set(); +} + void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p) @@ -151,7 +170,12 @@ void factor_vm::collect_growing_heap(cell requested_bytes, if(compact_code_heap_p) compact_code_heap(trace_contexts_p); - after_growing_heap_updater updater(this); + big_code_heap_update(); +} + +void factor_vm::small_code_heap_update() +{ + small_code_heap_updater updater(this); code->free_unmarked(updater); code->clear_remembered_set(); } @@ -163,11 +187,13 @@ void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p) reset_generation(data->tenured); collect_full_impl(trace_contexts_p); - if(compact_code_heap_p) compact_code_heap(trace_contexts_p); - - after_full_updater updater(this); - code->free_unmarked(updater); - code->clear_remembered_set(); + if(compact_code_heap_p) + { + compact_code_heap(trace_contexts_p); + big_code_heap_update(); + } + else + small_code_heap_update(); } } diff --git a/vm/full_collector.hpp b/vm/full_collector.hpp index d39358e0e2..c01f1cd486 100644 --- a/vm/full_collector.hpp +++ b/vm/full_collector.hpp @@ -19,6 +19,7 @@ struct full_collector : copying_collector { full_collector(factor_vm *myvm_); void mark_active_blocks(); void mark_object_code_block(object *object); + void trace_callbacks(); void trace_literal_references(code_block *compiled); void mark_code_block(code_block *compiled); void cheneys_algorithm(); diff --git a/vm/gc.cpp b/vm/gc.cpp index ebfed1fa23..c89add6066 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -96,17 +96,17 @@ void factor_vm::gc(gc_op op, current_gc = NULL; } -void factor_vm::primitive_full_gc() +void factor_vm::primitive_minor_gc() { - gc(collect_full_op, + gc(collect_nursery_op, 0, /* requested size */ true, /* trace contexts? */ false /* compact code heap? */); } -void factor_vm::primitive_minor_gc() +void factor_vm::primitive_full_gc() { - gc(collect_nursery_op, + gc(collect_full_op, 0, /* requested size */ true, /* trace contexts? */ false /* compact code heap? */); diff --git a/vm/image.cpp b/vm/image.cpp index 96ec2ce930..05e0d66724 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -114,7 +114,7 @@ bool factor_vm::save_image(const vm_char *filename) void factor_vm::primitive_save_image() { /* do a full GC to push everything into tenured space */ - primitive_full_gc(); + primitive_compact_gc(); gc_root path(dpop(),this); path.untag_check(this); diff --git a/vm/image.hpp b/vm/image.hpp index 80ee2556e9..f071185852 100755 --- a/vm/image.hpp +++ b/vm/image.hpp @@ -37,7 +37,9 @@ struct vm_parameters { bool secure_gc; bool fep; bool console; + bool signals; cell max_pic_size; + cell callback_size; }; } diff --git a/vm/master.hpp b/vm/master.hpp index 2058af8c43..c5aed5e983 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -82,6 +82,7 @@ namespace factor #include "image.hpp" #include "alien.hpp" #include "code_heap.hpp" +#include "callbacks.hpp" #include "vm.hpp" #include "tagged.hpp" #include "local_roots.hpp" diff --git a/vm/primitives.cpp b/vm/primitives.cpp index cc3c89b47e..ea02545148 100644 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -52,7 +52,9 @@ PRIMITIVE_FORWARD(word_xt) PRIMITIVE_FORWARD(getenv) PRIMITIVE_FORWARD(setenv) PRIMITIVE_FORWARD(existsp) +PRIMITIVE_FORWARD(minor_gc) PRIMITIVE_FORWARD(full_gc) +PRIMITIVE_FORWARD(compact_gc) PRIMITIVE_FORWARD(gc_stats) PRIMITIVE_FORWARD(save_image) PRIMITIVE_FORWARD(save_image_and_exit) @@ -127,6 +129,7 @@ PRIMITIVE_FORWARD(optimized_p) PRIMITIVE_FORWARD(quot_compiled_p) PRIMITIVE_FORWARD(vm_ptr) PRIMITIVE_FORWARD(strip_stack_traces) +PRIMITIVE_FORWARD(callback) const primitive_type primitives[] = { primitive_bignum_to_fixnum, @@ -187,7 +190,9 @@ const primitive_type primitives[] = { primitive_getenv, primitive_setenv, primitive_existsp, + primitive_minor_gc, primitive_full_gc, + primitive_compact_gc, primitive_gc_stats, primitive_save_image, primitive_save_image_and_exit, @@ -290,6 +295,7 @@ const primitive_type primitives[] = { primitive_quot_compiled_p, primitive_vm_ptr, primitive_strip_stack_traces, + primitive_callback, }; } diff --git a/vm/quotations.cpp b/vm/quotations.cpp index 6f4da51869..60fdce1003 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -362,7 +362,7 @@ fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset) cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack) { gc_root quot(quot_,this); - stack_chain->callstack_top = stack; + ctx->callstack_top = stack; jit_compile(quot.value(),true); return quot.value(); } diff --git a/vm/run.hpp b/vm/run.hpp index cfc2acfb5c..9a23979066 100755 --- a/vm/run.hpp +++ b/vm/run.hpp @@ -59,6 +59,9 @@ enum special_object { JIT_EXECUTE_CALL, JIT_DECLARE_WORD, + /* Callback stub generation in callbacks.c */ + CALLBACK_STUB = 45, + /* Polymorphic inline cache generation in inline_cache.c */ PIC_LOAD = 47, PIC_TAG, diff --git a/vm/vm.hpp b/vm/vm.hpp index 5031260da4..c3d71dc6f2 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -8,7 +8,7 @@ struct factor_vm // First five fields accessed directly by assembler. See vm.factor /* Current stacks */ - context *stack_chain; + context *ctx; /* New objects are allocated here */ zone nursery; @@ -55,6 +55,9 @@ struct factor_vm /* Code heap */ code_heap *code; + /* Pinned callback stubs */ + callback_heap *callbacks; + /* Only set if we're performing a GC */ gc_state *current_gc; @@ -96,7 +99,7 @@ struct factor_vm void save_stacks(); context *alloc_context(); void dealloc_context(context *old_context); - void nest_stacks(); + void nest_stacks(stack_frame *magic_frame); void unnest_stacks(); void init_stacks(cell ds_size_, cell rs_size_); bool stack_to_array(cell bottom, cell top); @@ -107,6 +110,18 @@ struct factor_vm void primitive_set_retainstack(); void primitive_check_datastack(); + template void iterate_active_frames(Iterator &iter) + { + context *ctx = this->ctx; + + while(ctx) + { + iterate_callstack(ctx,iter); + if(ctx->magic_frame) iter(ctx->magic_frame); + ctx = ctx->next; + } + } + // run void primitive_getenv(); void primitive_setenv(); @@ -238,13 +253,15 @@ struct factor_vm void collect_nursery(); void collect_aging(); void collect_to_tenured(); + void big_code_heap_update(); + void small_code_heap_update(); void collect_full_impl(bool trace_contexts_p); void collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p); void collect_full(bool trace_contexts_p, bool compact_code_heap_p); void record_gc_stats(generation_statistics *stats); void gc(gc_op op, cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p); - void primitive_full_gc(); void primitive_minor_gc(); + void primitive_full_gc(); void primitive_compact_gc(); void primitive_gc_stats(); void clear_gc_stats(); @@ -502,6 +519,7 @@ struct factor_vm void primitive_code_room(); void forward_object_xts(); void forward_context_xts(); + void forward_callback_xts(); void compact_code_heap(bool trace_contexts_p); void primitive_strip_stack_traces(); @@ -518,6 +536,10 @@ struct factor_vm } } + //callbacks + void init_callbacks(cell size); + void primitive_callback(); + //image void init_objects(image_header *h); void load_data_heap(FILE *file, image_header *h, vm_parameters *p);