Merge branch 'master' of http://factorcode.org/git/factor
commit
3d95494c1e
1
Makefile
1
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 \
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 <array> 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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ( -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ( -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 [ <callback> ] cache ;
|
||||
|
||||
: callback-bottom ( params -- )
|
||||
xt>> [ [ register-callback ] [ word-xt drop <alien> ] 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 <word> >>xt
|
||||
dup callback-bottom
|
||||
#alien-callback, ;
|
||||
|
|
|
@ -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
|
||||
|
||||
\ <callback> { word } { alien } define-primitive
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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" (( -- )) }
|
||||
{ "<callback>" "alien" (( word -- alien )) }
|
||||
} [ [ first3 ] dip swap make-primitive ] each-index
|
||||
|
||||
! Bump build number
|
||||
|
|
|
@ -148,7 +148,7 @@ HELP: parse-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 ;
|
||||
|
||||
|
|
|
@ -12,6 +12,8 @@ aging_collector::aging_collector(factor_vm *myvm_) :
|
|||
|
||||
void factor_vm::collect_aging()
|
||||
{
|
||||
/* Promote objects referenced from tenured space to tenured space, copy
|
||||
everything else to the aging semi-space, and reset the nursery pointer. */
|
||||
{
|
||||
/* Change the op so that if we fail here, we proceed to a full
|
||||
tenured collection. We are collecting to tenured space, and
|
||||
|
|
27
vm/alien.cpp
27
vm/alien.cpp
|
@ -87,12 +87,12 @@ void *factor_vm::alien_pointer()
|
|||
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
|
||||
PRIMITIVE(alien_##name) \
|
||||
{ \
|
||||
PRIMITIVE_GETVM()->boxer(*(type*)PRIMITIVE_GETVM()->alien_pointer()); \
|
||||
((factor_vm*)myvm)->boxer(*(type*)((factor_vm*)myvm)->alien_pointer()); \
|
||||
} \
|
||||
PRIMITIVE(set_alien_##name) \
|
||||
{ \
|
||||
type *ptr = (type *)PRIMITIVE_GETVM()->alien_pointer(); \
|
||||
type value = PRIMITIVE_GETVM()->to(dpop()); \
|
||||
type *ptr = (type *)((factor_vm*)myvm)->alien_pointer(); \
|
||||
type value = ((factor_vm*)myvm)->to(dpop()); \
|
||||
*ptr = value; \
|
||||
}
|
||||
|
||||
|
@ -184,8 +184,7 @@ char *factor_vm::alien_offset(cell obj)
|
|||
|
||||
VM_C_API char *alien_offset(cell obj, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->alien_offset(obj);
|
||||
return myvm->alien_offset(obj);
|
||||
}
|
||||
|
||||
/* pop an object representing a C pointer */
|
||||
|
@ -196,8 +195,7 @@ char *factor_vm::unbox_alien()
|
|||
|
||||
VM_C_API char *unbox_alien(factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->unbox_alien();
|
||||
return myvm->unbox_alien();
|
||||
}
|
||||
|
||||
/* make an alien and push */
|
||||
|
@ -211,8 +209,7 @@ void factor_vm::box_alien(void *ptr)
|
|||
|
||||
VM_C_API void box_alien(void *ptr, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_alien(ptr);
|
||||
return myvm->box_alien(ptr);
|
||||
}
|
||||
|
||||
/* for FFI calls passing structs by value */
|
||||
|
@ -223,8 +220,7 @@ void factor_vm::to_value_struct(cell src, void *dest, cell size)
|
|||
|
||||
VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_value_struct(src,dest,size);
|
||||
return myvm->to_value_struct(src,dest,size);
|
||||
}
|
||||
|
||||
/* for FFI callbacks receiving structs by value */
|
||||
|
@ -237,8 +233,7 @@ void factor_vm::box_value_struct(void *src, cell size)
|
|||
|
||||
VM_C_API void box_value_struct(void *src, cell size,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_value_struct(src,size);
|
||||
return myvm->box_value_struct(src,size);
|
||||
}
|
||||
|
||||
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
|
||||
|
@ -252,8 +247,7 @@ void factor_vm::box_small_struct(cell x, cell y, cell size)
|
|||
|
||||
VM_C_API void box_small_struct(cell x, cell y, cell size, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_small_struct(x,y,size);
|
||||
return myvm->box_small_struct(x,y,size);
|
||||
}
|
||||
|
||||
/* On OS X/PPC, complex numbers are returned in registers. */
|
||||
|
@ -269,8 +263,7 @@ void factor_vm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
|||
|
||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
|
||||
return myvm->box_medium_struct(x1, x2, x3, x4, size);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_vm_ptr()
|
||||
|
|
|
@ -10,8 +10,7 @@ void factor_vm::box_boolean(bool value)
|
|||
|
||||
VM_C_API void box_boolean(bool value, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_boolean(value);
|
||||
return myvm->box_boolean(value);
|
||||
}
|
||||
|
||||
bool factor_vm::to_boolean(cell value)
|
||||
|
@ -21,8 +20,7 @@ bool factor_vm::to_boolean(cell value)
|
|||
|
||||
VM_C_API bool to_boolean(cell value, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_boolean(value);
|
||||
return myvm->to_boolean(value);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -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<array> 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<array> code_template(myvm->userenv[CALLBACK_STUB]);
|
||||
tagged<byte_array> 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<void>(),size);
|
||||
|
||||
stub->size = align8(size);
|
||||
here += bump;
|
||||
|
||||
update(stub);
|
||||
|
||||
return stub;
|
||||
}
|
||||
|
||||
void factor_vm::primitive_callback()
|
||||
{
|
||||
tagged<word> w(dpop());
|
||||
w.untag_check(this);
|
||||
|
||||
callback *stub = callbacks->add(w->code);
|
||||
box_alien(stub + 1);
|
||||
}
|
||||
|
||||
}
|
|
@ -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<typename Iterator> void iterate(Iterator &iter)
|
||||
{
|
||||
callback *scan = (callback *)seg->start;
|
||||
callback *end = (callback *)here;
|
||||
while(scan < end)
|
||||
{
|
||||
iter(scan);
|
||||
scan = next(scan);
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
}
|
|
@ -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<callstack>(dpop());
|
||||
|
||||
set_callstack(stack_chain->callstack_bottom,
|
||||
set_callstack(ctx->callstack_bottom,
|
||||
stack->top(),
|
||||
untag_fixnum(stack->length),
|
||||
memcpy);
|
||||
|
@ -204,13 +201,12 @@ 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)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->save_callstack_bottom(callstack_bottom);
|
||||
return myvm->save_callstack_bottom(callstack_bottom);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -23,8 +23,11 @@ template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *
|
|||
}
|
||||
}
|
||||
|
||||
template<typename Iterator> void factor_vm::iterate_callstack(cell top, cell bottom, Iterator &iterator)
|
||||
template<typename Iterator> void factor_vm::iterate_callstack(context *ctx, Iterator &iterator)
|
||||
{
|
||||
cell top = (cell)ctx->callstack_top;
|
||||
cell bottom = (cell)ctx->callstack_bottom;
|
||||
|
||||
stack_frame *frame = (stack_frame *)bottom - 1;
|
||||
|
||||
while((cell)frame >= top)
|
||||
|
|
|
@ -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:
|
||||
|
@ -97,7 +97,7 @@ void factor_vm::undefined_symbol()
|
|||
|
||||
void undefined_symbol()
|
||||
{
|
||||
return SIGNAL_VM_PTR()->undefined_symbol();
|
||||
return tls_vm()->undefined_symbol();
|
||||
}
|
||||
|
||||
/* Look up an external library symbol referenced by a compiled code block */
|
||||
|
@ -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)
|
||||
{
|
||||
gc();
|
||||
primitive_compact_gc();
|
||||
block = code->heap_allot(size + sizeof(code_block),type);
|
||||
|
||||
/* Insufficient room even after code GC, give up */
|
||||
|
|
|
@ -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 */
|
||||
|
|
116
vm/code_heap.cpp
116
vm/code_heap.cpp
|
@ -3,7 +3,7 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
code_heap::code_heap(bool secure_gc, cell size) : heap(secure_gc,size) {}
|
||||
code_heap::code_heap(bool secure_gc, cell size) : heap(secure_gc,size,true) {}
|
||||
|
||||
void code_heap::write_barrier(code_block *compiled)
|
||||
{
|
||||
|
@ -11,6 +11,12 @@ void code_heap::write_barrier(code_block *compiled)
|
|||
points_to_aging.insert(compiled);
|
||||
}
|
||||
|
||||
void code_heap::clear_remembered_set()
|
||||
{
|
||||
points_to_nursery.clear();
|
||||
points_to_aging.clear();
|
||||
}
|
||||
|
||||
bool code_heap::needs_fixup_p(code_block *compiled)
|
||||
{
|
||||
return needs_fixup.count(compiled) > 0;
|
||||
|
@ -131,22 +137,24 @@ void factor_vm::primitive_code_room()
|
|||
dpush(tag_fixnum(max_free / 1024));
|
||||
}
|
||||
|
||||
code_block *factor_vm::forward_xt(code_block *compiled)
|
||||
code_block *code_heap::forward_code_block(code_block *compiled)
|
||||
{
|
||||
return (code_block *)code->forwarding[compiled];
|
||||
return (code_block *)forwarding[compiled];
|
||||
}
|
||||
|
||||
struct xt_forwarder {
|
||||
struct callframe_forwarder {
|
||||
factor_vm *myvm;
|
||||
|
||||
explicit xt_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
|
||||
explicit callframe_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
|
||||
|
||||
void operator()(stack_frame *frame)
|
||||
{
|
||||
cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)myvm->frame_code(frame);
|
||||
code_block *forwarded = myvm->forward_xt(myvm->frame_code(frame));
|
||||
cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)frame->xt;
|
||||
|
||||
code_block *forwarded = myvm->code->forward_code_block(myvm->frame_code(frame));
|
||||
frame->xt = forwarded->xt();
|
||||
FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)forwarded + offset);
|
||||
|
||||
FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)frame->xt + offset);
|
||||
}
|
||||
};
|
||||
|
||||
|
@ -165,9 +173,11 @@ void factor_vm::forward_object_xts()
|
|||
word *w = untag<word>(obj);
|
||||
|
||||
if(w->code)
|
||||
w->code = forward_xt(w->code);
|
||||
w->code = code->forward_code_block(w->code);
|
||||
if(w->profiling)
|
||||
w->profiling = forward_xt(w->profiling);
|
||||
w->profiling = code->forward_code_block(w->profiling);
|
||||
|
||||
update_word_xt(obj);
|
||||
}
|
||||
break;
|
||||
case QUOTATION_TYPE:
|
||||
|
@ -175,13 +185,16 @@ void factor_vm::forward_object_xts()
|
|||
quotation *quot = untag<quotation>(obj);
|
||||
|
||||
if(quot->code)
|
||||
quot->code = forward_xt(quot->code);
|
||||
{
|
||||
quot->code = code->forward_code_block(quot->code);
|
||||
set_quot_xt(quot,quot->code);
|
||||
}
|
||||
}
|
||||
break;
|
||||
case CALLSTACK_TYPE:
|
||||
{
|
||||
callstack *stack = untag<callstack>(obj);
|
||||
xt_forwarder forwarder(this);
|
||||
callframe_forwarder forwarder(this);
|
||||
iterate_callstack_object(stack,forwarder);
|
||||
}
|
||||
break;
|
||||
|
@ -193,59 +206,44 @@ void factor_vm::forward_object_xts()
|
|||
end_scan();
|
||||
}
|
||||
|
||||
/* Set the XT fields now that the heap has been compacted */
|
||||
void factor_vm::fixup_object_xts()
|
||||
void factor_vm::forward_context_xts()
|
||||
{
|
||||
begin_scan();
|
||||
|
||||
cell obj;
|
||||
|
||||
while((obj = next_object()) != F)
|
||||
{
|
||||
switch(tagged<object>(obj).type())
|
||||
{
|
||||
case WORD_TYPE:
|
||||
update_word_xt(obj);
|
||||
break;
|
||||
case QUOTATION_TYPE:
|
||||
{
|
||||
quotation *quot = untag<quotation>(obj);
|
||||
if(quot->code)
|
||||
set_quot_xt(quot,quot->code);
|
||||
break;
|
||||
}
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
end_scan();
|
||||
callframe_forwarder forwarder(this);
|
||||
iterate_active_frames(forwarder);
|
||||
}
|
||||
|
||||
/* Move all free space to the end of the code heap. This is not very efficient,
|
||||
since it makes several passes over the code and data heaps, but we only ever
|
||||
do this before saving a deployed image and exiting, so performaance is not
|
||||
critical here */
|
||||
void factor_vm::compact_code_heap()
|
||||
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)
|
||||
{
|
||||
stub->compiled = code->forward_code_block(stub->compiled);
|
||||
callbacks->update(stub);
|
||||
}
|
||||
};
|
||||
|
||||
void factor_vm::forward_callback_xts()
|
||||
{
|
||||
/* Free all unreachable code blocks, don't trace contexts */
|
||||
garbage_collection(collect_full_op,false,0);
|
||||
callback_forwarder forwarder(code,callbacks);
|
||||
callbacks->iterate(forwarder);
|
||||
}
|
||||
|
||||
/* Figure out where the code heap blocks are going to end up */
|
||||
cell size = code->compute_heap_forwarding();
|
||||
|
||||
/* Update word and quotation code pointers */
|
||||
forward_object_xts();
|
||||
|
||||
/* Actually perform the compaction */
|
||||
/* Move all free space to the end of the code heap. Live blocks must be marked
|
||||
on entry to this function. XTs in code blocks must be updated after this
|
||||
function returns. */
|
||||
void factor_vm::compact_code_heap(bool trace_contexts_p)
|
||||
{
|
||||
code->compact_heap();
|
||||
|
||||
/* Update word and quotation XTs */
|
||||
fixup_object_xts();
|
||||
|
||||
/* Now update the free list; there will be a single free block at
|
||||
the end */
|
||||
code->build_free_list(size);
|
||||
forward_object_xts();
|
||||
if(trace_contexts_p)
|
||||
{
|
||||
forward_context_xts();
|
||||
forward_callback_xts();
|
||||
}
|
||||
}
|
||||
|
||||
struct stack_trace_stripper {
|
||||
|
|
|
@ -13,8 +13,10 @@ struct code_heap : heap {
|
|||
|
||||
explicit code_heap(bool secure_gc, cell size);
|
||||
void write_barrier(code_block *compiled);
|
||||
void clear_remembered_set();
|
||||
bool needs_fixup_p(code_block *compiled);
|
||||
void code_heap_free(code_block *compiled);
|
||||
code_block *forward_code_block(code_block *compiled);
|
||||
};
|
||||
|
||||
}
|
||||
|
|
|
@ -132,17 +132,17 @@ template<typename TargetGeneration, typename Policy> struct collector {
|
|||
|
||||
void trace_contexts()
|
||||
{
|
||||
context *stacks = myvm->stack_chain;
|
||||
context *ctx = myvm->ctx;
|
||||
|
||||
while(stacks)
|
||||
while(ctx)
|
||||
{
|
||||
trace_stack_elements(stacks->datastack_region,(cell *)stacks->datastack);
|
||||
trace_stack_elements(stacks->retainstack_region,(cell *)stacks->retainstack);
|
||||
trace_stack_elements(ctx->datastack_region,(cell *)ctx->datastack);
|
||||
trace_stack_elements(ctx->retainstack_region,(cell *)ctx->retainstack);
|
||||
|
||||
trace_handle(&stacks->catchstack_save);
|
||||
trace_handle(&stacks->current_callback_save);
|
||||
trace_handle(&ctx->catchstack_save);
|
||||
trace_handle(&ctx->current_callback_save);
|
||||
|
||||
stacks = stacks->next;
|
||||
ctx = ctx->next;
|
||||
}
|
||||
}
|
||||
};
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -44,8 +44,8 @@ context *factor_vm::alloc_context()
|
|||
else
|
||||
{
|
||||
new_context = new context;
|
||||
new_context->datastack_region = new segment(ds_size);
|
||||
new_context->retainstack_region = new segment(rs_size);
|
||||
new_context->datastack_region = new segment(ds_size,false);
|
||||
new_context->retainstack_region = new segment(rs_size,false);
|
||||
}
|
||||
|
||||
return new_context;
|
||||
|
@ -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,45 +75,45 @@ 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)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->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_stacks = stack_chain;
|
||||
stack_chain = old_stacks->next;
|
||||
dealloc_context(old_stacks);
|
||||
context *old_ctx = ctx;
|
||||
ctx = old_ctx->next;
|
||||
dealloc_context(old_ctx);
|
||||
}
|
||||
|
||||
void unnest_stacks(factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->unnest_stacks();
|
||||
return myvm->unnest_stacks();
|
||||
}
|
||||
|
||||
/* called on startup */
|
||||
|
@ -121,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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
}
|
||||
|
|
|
@ -23,7 +23,7 @@ data_heap::data_heap(cell young_size_, cell aging_size_, cell tenured_size_)
|
|||
|
||||
total_size += deck_size;
|
||||
|
||||
seg = new segment(total_size);
|
||||
seg = new segment(total_size,false);
|
||||
|
||||
cell cards_size = addr_to_card(total_size);
|
||||
|
||||
|
|
|
@ -189,10 +189,8 @@ struct stack_frame_printer {
|
|||
void factor_vm::print_callstack()
|
||||
{
|
||||
print_string("==== CALL STACK:\n");
|
||||
cell bottom = (cell)stack_chain->callstack_bottom;
|
||||
cell top = (cell)stack_chain->callstack_top;
|
||||
stack_frame_printer printer(this);
|
||||
iterate_callstack(top,bottom,printer);
|
||||
iterate_callstack(ctx,printer);
|
||||
}
|
||||
|
||||
void factor_vm::dump_cell(cell x)
|
||||
|
@ -234,7 +232,7 @@ void factor_vm::dump_generations()
|
|||
|
||||
void factor_vm::dump_objects(cell type)
|
||||
{
|
||||
gc();
|
||||
primitive_full_gc();
|
||||
begin_scan();
|
||||
|
||||
cell obj;
|
||||
|
|
|
@ -15,13 +15,13 @@ void critical_error(const char *msg, cell tagged)
|
|||
print_string("You have triggered a bug in Factor. Please report.\n");
|
||||
print_string("critical_error: "); print_string(msg);
|
||||
print_string(": "); print_cell_hex(tagged); nl();
|
||||
SIGNAL_VM_PTR()->factorbug();
|
||||
tls_vm()->factorbug();
|
||||
}
|
||||
|
||||
void out_of_memory()
|
||||
{
|
||||
print_string("Out of memory\n\n");
|
||||
SIGNAL_VM_PTR()->dump_generations();
|
||||
tls_vm()->dump_generations();
|
||||
exit(1);
|
||||
}
|
||||
|
||||
|
@ -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 */
|
||||
|
@ -146,7 +143,7 @@ void factor_vm::memory_signal_handler_impl()
|
|||
|
||||
void memory_signal_handler_impl()
|
||||
{
|
||||
SIGNAL_VM_PTR()->memory_signal_handler_impl();
|
||||
tls_vm()->memory_signal_handler_impl();
|
||||
}
|
||||
|
||||
void factor_vm::misc_signal_handler_impl()
|
||||
|
@ -156,7 +153,7 @@ void factor_vm::misc_signal_handler_impl()
|
|||
|
||||
void misc_signal_handler_impl()
|
||||
{
|
||||
SIGNAL_VM_PTR()->misc_signal_handler_impl();
|
||||
tls_vm()->misc_signal_handler_impl();
|
||||
}
|
||||
|
||||
void factor_vm::fp_signal_handler_impl()
|
||||
|
@ -166,7 +163,7 @@ void factor_vm::fp_signal_handler_impl()
|
|||
|
||||
void fp_signal_handler_impl()
|
||||
{
|
||||
SIGNAL_VM_PTR()->fp_signal_handler_impl();
|
||||
tls_vm()->fp_signal_handler_impl();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -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();
|
||||
}
|
||||
|
|
|
@ -26,18 +26,8 @@ struct stack_frame_marker {
|
|||
/* Mark code blocks executing in currently active stack frames. */
|
||||
void full_collector::mark_active_blocks()
|
||||
{
|
||||
context *stacks = this->myvm->stack_chain;
|
||||
|
||||
while(stacks)
|
||||
{
|
||||
cell top = (cell)stacks->callstack_top;
|
||||
cell bottom = (cell)stacks->callstack_bottom;
|
||||
|
||||
stack_frame_marker marker(this);
|
||||
myvm->iterate_callstack(top,bottom,marker);
|
||||
|
||||
stacks = stacks->next;
|
||||
}
|
||||
stack_frame_marker marker(this);
|
||||
myvm->iterate_active_frames(marker);
|
||||
}
|
||||
|
||||
void full_collector::mark_object_code_block(object *obj)
|
||||
|
@ -70,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)
|
||||
{
|
||||
|
@ -99,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)
|
||||
{
|
||||
|
@ -112,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)
|
||||
{
|
||||
|
@ -123,23 +130,6 @@ struct after_full_updater {
|
|||
}
|
||||
};
|
||||
|
||||
void factor_vm::update_code_heap_for_full_gc(bool growing_data_heap)
|
||||
{
|
||||
if(growing_data_heap)
|
||||
{
|
||||
after_growing_heap_updater updater(this);
|
||||
code->free_unmarked(updater);
|
||||
}
|
||||
else
|
||||
{
|
||||
after_full_updater updater(this);
|
||||
code->free_unmarked(updater);
|
||||
}
|
||||
|
||||
code->points_to_nursery.clear();
|
||||
code->points_to_aging.clear();
|
||||
}
|
||||
|
||||
void factor_vm::collect_full_impl(bool trace_contexts_p)
|
||||
{
|
||||
full_collector collector(this);
|
||||
|
@ -149,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();
|
||||
|
@ -157,21 +148,52 @@ void factor_vm::collect_full_impl(bool trace_contexts_p)
|
|||
nursery.here = nursery.start;
|
||||
}
|
||||
|
||||
void factor_vm::collect_growing_heap(cell requested_bytes, 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)
|
||||
{
|
||||
/* Grow the data heap and copy all live objects to the new heap. */
|
||||
data_heap *old = data;
|
||||
set_data_heap(data->grow(requested_bytes));
|
||||
collect_full_impl(trace_contexts_p);
|
||||
update_code_heap_for_full_gc(true);
|
||||
delete old;
|
||||
|
||||
if(compact_code_heap_p) compact_code_heap(trace_contexts_p);
|
||||
|
||||
big_code_heap_update();
|
||||
}
|
||||
|
||||
void factor_vm::collect_full(bool trace_contexts_p)
|
||||
void factor_vm::small_code_heap_update()
|
||||
{
|
||||
small_code_heap_updater updater(this);
|
||||
code->free_unmarked(updater);
|
||||
code->clear_remembered_set();
|
||||
}
|
||||
|
||||
void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p)
|
||||
{
|
||||
/* Copy all live objects to the tenured semispace. */
|
||||
std::swap(data->tenured,data->tenured_semispace);
|
||||
reset_generation(data->tenured);
|
||||
collect_full_impl(trace_contexts_p);
|
||||
update_code_heap_for_full_gc(false);
|
||||
|
||||
if(compact_code_heap_p)
|
||||
{
|
||||
compact_code_heap(trace_contexts_p);
|
||||
big_code_heap_update();
|
||||
}
|
||||
else
|
||||
small_code_heap_update();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -19,6 +19,7 @@ struct full_collector : copying_collector<tenured_space,full_policy> {
|
|||
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();
|
||||
|
|
56
vm/gc.cpp
56
vm/gc.cpp
|
@ -25,10 +25,10 @@ void factor_vm::record_gc_stats(generation_statistics *stats)
|
|||
stats->max_gc_time = gc_elapsed;
|
||||
}
|
||||
|
||||
/* Collect gen and all younger generations.
|
||||
If growing_data_heap_ is true, we must grow the data heap to such a size that
|
||||
an allocation of requested_bytes won't fail */
|
||||
void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes)
|
||||
void factor_vm::gc(gc_op op,
|
||||
cell requested_bytes,
|
||||
bool trace_contexts_p,
|
||||
bool compact_code_heap_p)
|
||||
{
|
||||
assert(!gc_off);
|
||||
assert(!current_gc);
|
||||
|
@ -80,11 +80,11 @@ void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell request
|
|||
record_gc_stats(&gc_stats.aging_stats);
|
||||
break;
|
||||
case collect_full_op:
|
||||
collect_full(trace_contexts_p);
|
||||
collect_full(trace_contexts_p,compact_code_heap_p);
|
||||
record_gc_stats(&gc_stats.full_stats);
|
||||
break;
|
||||
case collect_growing_heap_op:
|
||||
collect_growing_heap(requested_bytes,trace_contexts_p);
|
||||
collect_growing_heap(requested_bytes,trace_contexts_p,compact_code_heap_p);
|
||||
record_gc_stats(&gc_stats.full_stats);
|
||||
break;
|
||||
default:
|
||||
|
@ -96,14 +96,28 @@ void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell request
|
|||
current_gc = NULL;
|
||||
}
|
||||
|
||||
void factor_vm::gc()
|
||||
void factor_vm::primitive_minor_gc()
|
||||
{
|
||||
garbage_collection(collect_full_op,true,0);
|
||||
gc(collect_nursery_op,
|
||||
0, /* requested size */
|
||||
true, /* trace contexts? */
|
||||
false /* compact code heap? */);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_gc()
|
||||
void factor_vm::primitive_full_gc()
|
||||
{
|
||||
gc();
|
||||
gc(collect_full_op,
|
||||
0, /* requested size */
|
||||
true, /* trace contexts? */
|
||||
false /* compact code heap? */);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_compact_gc()
|
||||
{
|
||||
gc(collect_full_op,
|
||||
0, /* requested size */
|
||||
true, /* trace contexts? */
|
||||
true /* compact code heap? */);
|
||||
}
|
||||
|
||||
void factor_vm::add_gc_stats(generation_statistics *stats, growable_array *result)
|
||||
|
@ -171,7 +185,7 @@ void factor_vm::primitive_become()
|
|||
old_obj->h.forward_to(new_obj.untagged());
|
||||
}
|
||||
|
||||
gc();
|
||||
primitive_full_gc();
|
||||
|
||||
/* If a word's definition quotation was in old_objects and the
|
||||
quotation in new_objects is not compiled, we might leak memory
|
||||
|
@ -185,7 +199,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
|
|||
for(cell i = 0; i < gc_roots_size; i++)
|
||||
gc_locals.push_back((cell)&gc_roots_base[i]);
|
||||
|
||||
garbage_collection(collect_nursery_op,true,0);
|
||||
primitive_minor_gc();
|
||||
|
||||
for(cell i = 0; i < gc_roots_size; i++)
|
||||
gc_locals.pop_back();
|
||||
|
@ -193,8 +207,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
|
|||
|
||||
VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
|
||||
myvm->inline_gc(gc_roots_base,gc_roots_size);
|
||||
}
|
||||
|
||||
/*
|
||||
|
@ -205,16 +218,18 @@ object *factor_vm::allot_object(header header, cell size)
|
|||
{
|
||||
#ifdef GC_DEBUG
|
||||
if(!gc_off)
|
||||
gc();
|
||||
primitive_full_gc();
|
||||
#endif
|
||||
|
||||
object *obj;
|
||||
|
||||
/* If the object is smaller than the nursery, allocate it in the nursery,
|
||||
after a GC if needed */
|
||||
if(nursery.size > size)
|
||||
{
|
||||
/* If there is insufficient room, collect the nursery */
|
||||
if(nursery.here + size > nursery.end)
|
||||
garbage_collection(collect_nursery_op,true,0);
|
||||
primitive_minor_gc();
|
||||
|
||||
obj = nursery.allot(size);
|
||||
}
|
||||
|
@ -224,11 +239,16 @@ object *factor_vm::allot_object(header header, cell size)
|
|||
{
|
||||
/* If tenured space does not have enough room, collect */
|
||||
if(data->tenured->here + size > data->tenured->end)
|
||||
gc();
|
||||
primitive_full_gc();
|
||||
|
||||
/* If it still won't fit, grow the heap */
|
||||
if(data->tenured->here + size > data->tenured->end)
|
||||
garbage_collection(collect_growing_heap_op,true,size);
|
||||
{
|
||||
gc(collect_growing_heap_op,
|
||||
size, /* requested size */
|
||||
true, /* trace contexts? */
|
||||
false /* compact code heap? */);
|
||||
}
|
||||
|
||||
obj = data->tenured->allot(size);
|
||||
|
||||
|
|
43
vm/heap.cpp
43
vm/heap.cpp
|
@ -11,10 +11,10 @@ void heap::clear_free_list()
|
|||
memset(&free,0,sizeof(heap_free_list));
|
||||
}
|
||||
|
||||
heap::heap(bool secure_gc_, cell size) : secure_gc(secure_gc_)
|
||||
heap::heap(bool secure_gc_, cell size, bool executable_p) : secure_gc(secure_gc_)
|
||||
{
|
||||
if(size > (1L << (sizeof(cell) * 8 - 6))) fatal_error("Heap too large",size);
|
||||
seg = new segment(align_page(size));
|
||||
seg = new segment(align_page(size),executable_p);
|
||||
if(!seg) fatal_error("Out of memory in heap allocator",size);
|
||||
clear_free_list();
|
||||
}
|
||||
|
@ -226,37 +226,32 @@ cell heap::heap_size()
|
|||
return seg->size;
|
||||
}
|
||||
|
||||
/* Compute where each block is going to go, after compaction */
|
||||
cell heap::compute_heap_forwarding()
|
||||
{
|
||||
heap_block *scan = first_block();
|
||||
char *address = (char *)first_block();
|
||||
|
||||
while(scan)
|
||||
{
|
||||
if(scan->type() != FREE_BLOCK_TYPE)
|
||||
{
|
||||
forwarding[scan] = address;
|
||||
address += scan->size();
|
||||
}
|
||||
scan = next_block(scan);
|
||||
}
|
||||
|
||||
return (cell)address - seg->start;
|
||||
}
|
||||
|
||||
void heap::compact_heap()
|
||||
{
|
||||
heap_block *scan = first_block();
|
||||
forwarding.clear();
|
||||
|
||||
heap_block *scan = first_block();
|
||||
char *address = (char *)scan;
|
||||
|
||||
/* Slide blocks up while building the forwarding hashtable. */
|
||||
while(scan)
|
||||
{
|
||||
heap_block *next = next_block(scan);
|
||||
|
||||
if(scan->type() != FREE_BLOCK_TYPE && scan->marked_p())
|
||||
{
|
||||
cell size = scan->size();
|
||||
memmove(address,scan,size);
|
||||
forwarding[scan] = address;
|
||||
address += size;
|
||||
}
|
||||
|
||||
if(scan->type() != FREE_BLOCK_TYPE)
|
||||
memmove(forwarding[scan],scan,scan->size());
|
||||
scan = next;
|
||||
}
|
||||
|
||||
/* Now update the free list; there will be a single free block at
|
||||
the end */
|
||||
build_free_list((cell)address - seg->start);
|
||||
}
|
||||
|
||||
heap_block *heap::free_allocated(heap_block *prev, heap_block *scan)
|
||||
|
|
|
@ -15,7 +15,7 @@ struct heap {
|
|||
heap_free_list free;
|
||||
unordered_map<heap_block *, char *> forwarding;
|
||||
|
||||
explicit heap(bool secure_gc_, cell size);
|
||||
explicit heap(bool secure_gc_, cell size, bool executable_p);
|
||||
|
||||
inline heap_block *next_block(heap_block *block)
|
||||
{
|
||||
|
@ -49,7 +49,6 @@ struct heap {
|
|||
void clear_mark_bits();
|
||||
void heap_usage(cell *used, cell *total_free, cell *max_free);
|
||||
cell heap_size();
|
||||
cell compute_heap_forwarding();
|
||||
void compact_heap();
|
||||
|
||||
heap_block *free_allocated(heap_block *prev, heap_block *scan);
|
||||
|
|
|
@ -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 */
|
||||
gc();
|
||||
primitive_compact_gc();
|
||||
|
||||
gc_root<byte_array> path(dpop(),this);
|
||||
path.untag_check(this);
|
||||
|
@ -135,8 +135,10 @@ void factor_vm::primitive_save_image_and_exit()
|
|||
if(!save_env_p(i)) userenv[i] = F;
|
||||
}
|
||||
|
||||
/* do a full GC + code heap compaction */
|
||||
compact_code_heap();
|
||||
gc(collect_full_op,
|
||||
0, /* requested size */
|
||||
false, /* discard objects only reachable from stacks */
|
||||
true /* compact the code heap */);
|
||||
|
||||
/* Save the image */
|
||||
if(save_image((vm_char *)(path.untagged() + 1)))
|
||||
|
|
|
@ -37,7 +37,9 @@ struct vm_parameters {
|
|||
bool secure_gc;
|
||||
bool fep;
|
||||
bool console;
|
||||
bool signals;
|
||||
cell max_pic_size;
|
||||
cell callback_size;
|
||||
};
|
||||
|
||||
}
|
||||
|
|
|
@ -250,8 +250,7 @@ void *factor_vm::inline_cache_miss(cell return_address)
|
|||
|
||||
VM_C_API void *inline_cache_miss(cell return_address, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->inline_cache_miss(return_address);
|
||||
return myvm->inline_cache_miss(return_address);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_reset_inline_cache_stats()
|
||||
|
|
|
@ -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"
|
||||
|
|
60
vm/math.cpp
60
vm/math.cpp
|
@ -395,8 +395,7 @@ fixnum factor_vm::to_fixnum(cell tagged)
|
|||
|
||||
VM_C_API fixnum to_fixnum(cell tagged,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_fixnum(tagged);
|
||||
return myvm->to_fixnum(tagged);
|
||||
}
|
||||
|
||||
cell factor_vm::to_cell(cell tagged)
|
||||
|
@ -406,8 +405,7 @@ cell factor_vm::to_cell(cell tagged)
|
|||
|
||||
VM_C_API cell to_cell(cell tagged, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_cell(tagged);
|
||||
return myvm->to_cell(tagged);
|
||||
}
|
||||
|
||||
void factor_vm::box_signed_1(s8 n)
|
||||
|
@ -417,8 +415,7 @@ void factor_vm::box_signed_1(s8 n)
|
|||
|
||||
VM_C_API void box_signed_1(s8 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_1(n);
|
||||
return myvm->box_signed_1(n);
|
||||
}
|
||||
|
||||
void factor_vm::box_unsigned_1(u8 n)
|
||||
|
@ -428,8 +425,7 @@ void factor_vm::box_unsigned_1(u8 n)
|
|||
|
||||
VM_C_API void box_unsigned_1(u8 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_1(n);
|
||||
return myvm->box_unsigned_1(n);
|
||||
}
|
||||
|
||||
void factor_vm::box_signed_2(s16 n)
|
||||
|
@ -439,8 +435,7 @@ void factor_vm::box_signed_2(s16 n)
|
|||
|
||||
VM_C_API void box_signed_2(s16 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_2(n);
|
||||
return myvm->box_signed_2(n);
|
||||
}
|
||||
|
||||
void factor_vm::box_unsigned_2(u16 n)
|
||||
|
@ -450,8 +445,7 @@ void factor_vm::box_unsigned_2(u16 n)
|
|||
|
||||
VM_C_API void box_unsigned_2(u16 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_2(n);
|
||||
return myvm->box_unsigned_2(n);
|
||||
}
|
||||
|
||||
void factor_vm::box_signed_4(s32 n)
|
||||
|
@ -461,8 +455,7 @@ void factor_vm::box_signed_4(s32 n)
|
|||
|
||||
VM_C_API void box_signed_4(s32 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_4(n);
|
||||
return myvm->box_signed_4(n);
|
||||
}
|
||||
|
||||
void factor_vm::box_unsigned_4(u32 n)
|
||||
|
@ -472,8 +465,7 @@ void factor_vm::box_unsigned_4(u32 n)
|
|||
|
||||
VM_C_API void box_unsigned_4(u32 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_4(n);
|
||||
return myvm->box_unsigned_4(n);
|
||||
}
|
||||
|
||||
void factor_vm::box_signed_cell(fixnum integer)
|
||||
|
@ -483,8 +475,7 @@ void factor_vm::box_signed_cell(fixnum integer)
|
|||
|
||||
VM_C_API void box_signed_cell(fixnum integer,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_cell(integer);
|
||||
return myvm->box_signed_cell(integer);
|
||||
}
|
||||
|
||||
void factor_vm::box_unsigned_cell(cell cell)
|
||||
|
@ -494,8 +485,7 @@ void factor_vm::box_unsigned_cell(cell cell)
|
|||
|
||||
VM_C_API void box_unsigned_cell(cell cell,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_cell(cell);
|
||||
return myvm->box_unsigned_cell(cell);
|
||||
}
|
||||
|
||||
void factor_vm::box_signed_8(s64 n)
|
||||
|
@ -508,8 +498,7 @@ void factor_vm::box_signed_8(s64 n)
|
|||
|
||||
VM_C_API void box_signed_8(s64 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_8(n);
|
||||
return myvm->box_signed_8(n);
|
||||
}
|
||||
|
||||
s64 factor_vm::to_signed_8(cell obj)
|
||||
|
@ -528,8 +517,7 @@ s64 factor_vm::to_signed_8(cell obj)
|
|||
|
||||
VM_C_API s64 to_signed_8(cell obj,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_signed_8(obj);
|
||||
return myvm->to_signed_8(obj);
|
||||
}
|
||||
|
||||
void factor_vm::box_unsigned_8(u64 n)
|
||||
|
@ -542,8 +530,7 @@ void factor_vm::box_unsigned_8(u64 n)
|
|||
|
||||
VM_C_API void box_unsigned_8(u64 n,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_8(n);
|
||||
return myvm->box_unsigned_8(n);
|
||||
}
|
||||
|
||||
u64 factor_vm::to_unsigned_8(cell obj)
|
||||
|
@ -562,8 +549,7 @@ u64 factor_vm::to_unsigned_8(cell obj)
|
|||
|
||||
VM_C_API u64 to_unsigned_8(cell obj,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_unsigned_8(obj);
|
||||
return myvm->to_unsigned_8(obj);
|
||||
}
|
||||
|
||||
void factor_vm::box_float(float flo)
|
||||
|
@ -573,8 +559,7 @@ void factor_vm::box_float(float flo)
|
|||
|
||||
VM_C_API void box_float(float flo, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_float(flo);
|
||||
return myvm->box_float(flo);
|
||||
}
|
||||
|
||||
float factor_vm::to_float(cell value)
|
||||
|
@ -584,8 +569,7 @@ float factor_vm::to_float(cell value)
|
|||
|
||||
VM_C_API float to_float(cell value,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_float(value);
|
||||
return myvm->to_float(value);
|
||||
}
|
||||
|
||||
void factor_vm::box_double(double flo)
|
||||
|
@ -595,8 +579,7 @@ void factor_vm::box_double(double flo)
|
|||
|
||||
VM_C_API void box_double(double flo,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_double(flo);
|
||||
return myvm->box_double(flo);
|
||||
}
|
||||
|
||||
double factor_vm::to_double(cell value)
|
||||
|
@ -606,8 +589,7 @@ double factor_vm::to_double(cell value)
|
|||
|
||||
VM_C_API double to_double(cell value,factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_double(value);
|
||||
return myvm->to_double(value);
|
||||
}
|
||||
|
||||
/* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
|
||||
|
@ -620,7 +602,7 @@ inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y)
|
|||
|
||||
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *myvm)
|
||||
{
|
||||
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
|
||||
((factor_vm*)myvm)->overflow_fixnum_add(x,y);
|
||||
}
|
||||
|
||||
inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y)
|
||||
|
@ -631,7 +613,7 @@ inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y)
|
|||
|
||||
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *myvm)
|
||||
{
|
||||
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
|
||||
((factor_vm*)myvm)->overflow_fixnum_subtract(x,y);
|
||||
}
|
||||
|
||||
inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y)
|
||||
|
@ -645,7 +627,7 @@ inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y)
|
|||
|
||||
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *myvm)
|
||||
{
|
||||
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
|
||||
((factor_vm*)myvm)->overflow_fixnum_multiply(x,y);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -12,6 +12,8 @@ nursery_collector::nursery_collector(factor_vm *myvm_) :
|
|||
|
||||
void factor_vm::collect_nursery()
|
||||
{
|
||||
/* Copy live objects from the nursery (as determined by the root set and
|
||||
marked cards in aging and tenured) to aging space. */
|
||||
nursery_collector collector(this);
|
||||
|
||||
collector.trace_roots();
|
||||
|
|
|
@ -25,7 +25,7 @@ void flush_icache(cell start, cell len)
|
|||
: "r0","r1","r2");
|
||||
|
||||
if(result < 0)
|
||||
SIGNAL_VM_PTR->critical_error("flush_icache() failed",result);
|
||||
tls_vm()critical_error("flush_icache() failed",result);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -45,19 +45,19 @@ VM_C_API int inotify_rm_watch(int fd, u32 wd)
|
|||
|
||||
VM_C_API int inotify_init()
|
||||
{
|
||||
VM_PTR->not_implemented_error();
|
||||
myvm->not_implemented_error();
|
||||
return -1;
|
||||
}
|
||||
|
||||
VM_C_API int inotify_add_watch(int fd, const char *name, u32 mask)
|
||||
{
|
||||
VM_PTR->not_implemented_error();
|
||||
myvm->not_implemented_error();
|
||||
return -1;
|
||||
}
|
||||
|
||||
VM_C_API int inotify_rm_watch(int fd, u32 wd)
|
||||
{
|
||||
VM_PTR->not_implemented_error();
|
||||
myvm->not_implemented_error();
|
||||
return -1;
|
||||
}
|
||||
|
||||
|
|
|
@ -83,16 +83,19 @@ void factor_vm::primitive_existsp()
|
|||
box_boolean(stat(path,&sb) >= 0);
|
||||
}
|
||||
|
||||
segment::segment(cell size_)
|
||||
segment::segment(cell size_, bool executable_p)
|
||||
{
|
||||
size = size_;
|
||||
|
||||
int pagesize = getpagesize();
|
||||
|
||||
char *array = (char *)mmap(NULL,pagesize + size + pagesize,
|
||||
PROT_READ | PROT_WRITE | PROT_EXEC,
|
||||
MAP_ANON | MAP_PRIVATE,-1,0);
|
||||
int prot;
|
||||
if(executable_p)
|
||||
prot = (PROT_READ | PROT_WRITE | PROT_EXEC);
|
||||
else
|
||||
prot = (PROT_READ | PROT_WRITE);
|
||||
|
||||
char *array = (char *)mmap(NULL,pagesize + size + pagesize,prot,MAP_ANON | MAP_PRIVATE,-1,0);
|
||||
if(array == (char*)-1) out_of_memory();
|
||||
|
||||
if(mprotect(array,pagesize,PROT_NONE) == -1)
|
||||
|
@ -139,7 +142,7 @@ void factor_vm::memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
|||
|
||||
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
SIGNAL_VM_PTR()->memory_signal_handler(signal,siginfo,uap);
|
||||
tls_vm()->memory_signal_handler(signal,siginfo,uap);
|
||||
}
|
||||
|
||||
void factor_vm::misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
|
@ -151,7 +154,7 @@ void factor_vm::misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
|||
|
||||
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
SIGNAL_VM_PTR()->misc_signal_handler(signal,siginfo,uap);
|
||||
tls_vm()->misc_signal_handler(signal,siginfo,uap);
|
||||
}
|
||||
|
||||
void factor_vm::fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
|
@ -168,7 +171,7 @@ void factor_vm::fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
|||
|
||||
void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
SIGNAL_VM_PTR()->fpe_signal_handler(signal, siginfo, uap);
|
||||
tls_vm()->fpe_signal_handler(signal, siginfo, uap);
|
||||
}
|
||||
|
||||
static void sigaction_safe(int signum, const struct sigaction *act, struct sigaction *oldact)
|
||||
|
|
|
@ -85,7 +85,7 @@ LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe)
|
|||
|
||||
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
|
||||
{
|
||||
return SIGNAL_VM_PTR()->exception_handler(pe);
|
||||
return tls_vm()->exception_handler(pe);
|
||||
}
|
||||
|
||||
bool handler_added = 0;
|
||||
|
|
|
@ -96,7 +96,7 @@ void factor_vm::primitive_existsp()
|
|||
box_boolean(windows_stat(path));
|
||||
}
|
||||
|
||||
segment::segment(cell size_)
|
||||
segment::segment(cell size_, bool executable_p)
|
||||
{
|
||||
size = size_;
|
||||
|
||||
|
@ -104,7 +104,7 @@ segment::segment(cell size_)
|
|||
DWORD ignore;
|
||||
|
||||
if((mem = (char *)VirtualAlloc(NULL, getpagesize() * 2 + size,
|
||||
MEM_COMMIT, PAGE_EXECUTE_READWRITE)) == 0)
|
||||
MEM_COMMIT, executable_p ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE)) == 0)
|
||||
out_of_memory();
|
||||
|
||||
if (!VirtualProtect(mem, getpagesize(), PAGE_NOACCESS, &ignore))
|
||||
|
|
|
@ -3,6 +3,134 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_to_fixnum)
|
||||
PRIMITIVE_FORWARD(float_to_fixnum)
|
||||
PRIMITIVE_FORWARD(fixnum_to_bignum)
|
||||
PRIMITIVE_FORWARD(float_to_bignum)
|
||||
PRIMITIVE_FORWARD(fixnum_to_float)
|
||||
PRIMITIVE_FORWARD(bignum_to_float)
|
||||
PRIMITIVE_FORWARD(str_to_float)
|
||||
PRIMITIVE_FORWARD(float_to_str)
|
||||
PRIMITIVE_FORWARD(float_bits)
|
||||
PRIMITIVE_FORWARD(double_bits)
|
||||
PRIMITIVE_FORWARD(bits_float)
|
||||
PRIMITIVE_FORWARD(bits_double)
|
||||
PRIMITIVE_FORWARD(fixnum_divint)
|
||||
PRIMITIVE_FORWARD(fixnum_divmod)
|
||||
PRIMITIVE_FORWARD(fixnum_shift)
|
||||
PRIMITIVE_FORWARD(bignum_eq)
|
||||
PRIMITIVE_FORWARD(bignum_add)
|
||||
PRIMITIVE_FORWARD(bignum_subtract)
|
||||
PRIMITIVE_FORWARD(bignum_multiply)
|
||||
PRIMITIVE_FORWARD(bignum_divint)
|
||||
PRIMITIVE_FORWARD(bignum_mod)
|
||||
PRIMITIVE_FORWARD(bignum_divmod)
|
||||
PRIMITIVE_FORWARD(bignum_and)
|
||||
PRIMITIVE_FORWARD(bignum_or)
|
||||
PRIMITIVE_FORWARD(bignum_xor)
|
||||
PRIMITIVE_FORWARD(bignum_not)
|
||||
PRIMITIVE_FORWARD(bignum_shift)
|
||||
PRIMITIVE_FORWARD(bignum_less)
|
||||
PRIMITIVE_FORWARD(bignum_lesseq)
|
||||
PRIMITIVE_FORWARD(bignum_greater)
|
||||
PRIMITIVE_FORWARD(bignum_greatereq)
|
||||
PRIMITIVE_FORWARD(bignum_bitp)
|
||||
PRIMITIVE_FORWARD(bignum_log2)
|
||||
PRIMITIVE_FORWARD(byte_array_to_bignum)
|
||||
PRIMITIVE_FORWARD(float_eq)
|
||||
PRIMITIVE_FORWARD(float_add)
|
||||
PRIMITIVE_FORWARD(float_subtract)
|
||||
PRIMITIVE_FORWARD(float_multiply)
|
||||
PRIMITIVE_FORWARD(float_divfloat)
|
||||
PRIMITIVE_FORWARD(float_mod)
|
||||
PRIMITIVE_FORWARD(float_less)
|
||||
PRIMITIVE_FORWARD(float_lesseq)
|
||||
PRIMITIVE_FORWARD(float_greater)
|
||||
PRIMITIVE_FORWARD(float_greatereq)
|
||||
PRIMITIVE_FORWARD(word)
|
||||
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)
|
||||
PRIMITIVE_FORWARD(datastack)
|
||||
PRIMITIVE_FORWARD(retainstack)
|
||||
PRIMITIVE_FORWARD(callstack)
|
||||
PRIMITIVE_FORWARD(set_datastack)
|
||||
PRIMITIVE_FORWARD(set_retainstack)
|
||||
PRIMITIVE_FORWARD(set_callstack)
|
||||
PRIMITIVE_FORWARD(exit)
|
||||
PRIMITIVE_FORWARD(data_room)
|
||||
PRIMITIVE_FORWARD(code_room)
|
||||
PRIMITIVE_FORWARD(micros)
|
||||
PRIMITIVE_FORWARD(modify_code_heap)
|
||||
PRIMITIVE_FORWARD(dlopen)
|
||||
PRIMITIVE_FORWARD(dlsym)
|
||||
PRIMITIVE_FORWARD(dlclose)
|
||||
PRIMITIVE_FORWARD(byte_array)
|
||||
PRIMITIVE_FORWARD(uninitialized_byte_array)
|
||||
PRIMITIVE_FORWARD(displaced_alien)
|
||||
PRIMITIVE_FORWARD(alien_address)
|
||||
PRIMITIVE_FORWARD(set_slot)
|
||||
PRIMITIVE_FORWARD(string_nth)
|
||||
PRIMITIVE_FORWARD(set_string_nth_fast)
|
||||
PRIMITIVE_FORWARD(set_string_nth_slow)
|
||||
PRIMITIVE_FORWARD(resize_array)
|
||||
PRIMITIVE_FORWARD(resize_string)
|
||||
PRIMITIVE_FORWARD(array)
|
||||
PRIMITIVE_FORWARD(begin_scan)
|
||||
PRIMITIVE_FORWARD(next_object)
|
||||
PRIMITIVE_FORWARD(end_scan)
|
||||
PRIMITIVE_FORWARD(size)
|
||||
PRIMITIVE_FORWARD(die)
|
||||
PRIMITIVE_FORWARD(fopen)
|
||||
PRIMITIVE_FORWARD(fgetc)
|
||||
PRIMITIVE_FORWARD(fread)
|
||||
PRIMITIVE_FORWARD(fputc)
|
||||
PRIMITIVE_FORWARD(fwrite)
|
||||
PRIMITIVE_FORWARD(fflush)
|
||||
PRIMITIVE_FORWARD(ftell)
|
||||
PRIMITIVE_FORWARD(fseek)
|
||||
PRIMITIVE_FORWARD(fclose)
|
||||
PRIMITIVE_FORWARD(wrapper)
|
||||
PRIMITIVE_FORWARD(clone)
|
||||
PRIMITIVE_FORWARD(string)
|
||||
PRIMITIVE_FORWARD(array_to_quotation)
|
||||
PRIMITIVE_FORWARD(quotation_xt)
|
||||
PRIMITIVE_FORWARD(tuple)
|
||||
PRIMITIVE_FORWARD(profiling)
|
||||
PRIMITIVE_FORWARD(become)
|
||||
PRIMITIVE_FORWARD(sleep)
|
||||
PRIMITIVE_FORWARD(tuple_boa)
|
||||
PRIMITIVE_FORWARD(callstack_to_array)
|
||||
PRIMITIVE_FORWARD(innermost_stack_frame_executing)
|
||||
PRIMITIVE_FORWARD(innermost_stack_frame_scan)
|
||||
PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
|
||||
PRIMITIVE_FORWARD(call_clear)
|
||||
PRIMITIVE_FORWARD(resize_byte_array)
|
||||
PRIMITIVE_FORWARD(dll_validp)
|
||||
PRIMITIVE_FORWARD(unimplemented)
|
||||
PRIMITIVE_FORWARD(clear_gc_stats)
|
||||
PRIMITIVE_FORWARD(jit_compile)
|
||||
PRIMITIVE_FORWARD(load_locals)
|
||||
PRIMITIVE_FORWARD(check_datastack)
|
||||
PRIMITIVE_FORWARD(mega_cache_miss)
|
||||
PRIMITIVE_FORWARD(lookup_method)
|
||||
PRIMITIVE_FORWARD(reset_dispatch_stats)
|
||||
PRIMITIVE_FORWARD(dispatch_stats)
|
||||
PRIMITIVE_FORWARD(reset_inline_cache_stats)
|
||||
PRIMITIVE_FORWARD(inline_cache_stats)
|
||||
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,
|
||||
primitive_float_to_fixnum,
|
||||
|
@ -62,7 +190,9 @@ const primitive_type primitives[] = {
|
|||
primitive_getenv,
|
||||
primitive_setenv,
|
||||
primitive_existsp,
|
||||
primitive_gc,
|
||||
primitive_minor_gc,
|
||||
primitive_full_gc,
|
||||
primitive_compact_gc,
|
||||
primitive_gc_stats,
|
||||
primitive_save_image,
|
||||
primitive_save_image_and_exit,
|
||||
|
@ -165,131 +295,7 @@ const primitive_type primitives[] = {
|
|||
primitive_quot_compiled_p,
|
||||
primitive_vm_ptr,
|
||||
primitive_strip_stack_traces,
|
||||
primitive_callback,
|
||||
};
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_to_fixnum)
|
||||
PRIMITIVE_FORWARD(float_to_fixnum)
|
||||
PRIMITIVE_FORWARD(fixnum_to_bignum)
|
||||
PRIMITIVE_FORWARD(float_to_bignum)
|
||||
PRIMITIVE_FORWARD(fixnum_to_float)
|
||||
PRIMITIVE_FORWARD(bignum_to_float)
|
||||
PRIMITIVE_FORWARD(str_to_float)
|
||||
PRIMITIVE_FORWARD(float_to_str)
|
||||
PRIMITIVE_FORWARD(float_bits)
|
||||
PRIMITIVE_FORWARD(double_bits)
|
||||
PRIMITIVE_FORWARD(bits_float)
|
||||
PRIMITIVE_FORWARD(bits_double)
|
||||
PRIMITIVE_FORWARD(fixnum_divint)
|
||||
PRIMITIVE_FORWARD(fixnum_divmod)
|
||||
PRIMITIVE_FORWARD(fixnum_shift)
|
||||
PRIMITIVE_FORWARD(bignum_eq)
|
||||
PRIMITIVE_FORWARD(bignum_add)
|
||||
PRIMITIVE_FORWARD(bignum_subtract)
|
||||
PRIMITIVE_FORWARD(bignum_multiply)
|
||||
PRIMITIVE_FORWARD(bignum_divint)
|
||||
PRIMITIVE_FORWARD(bignum_mod)
|
||||
PRIMITIVE_FORWARD(bignum_divmod)
|
||||
PRIMITIVE_FORWARD(bignum_and)
|
||||
PRIMITIVE_FORWARD(bignum_or)
|
||||
PRIMITIVE_FORWARD(bignum_xor)
|
||||
PRIMITIVE_FORWARD(bignum_not)
|
||||
PRIMITIVE_FORWARD(bignum_shift)
|
||||
PRIMITIVE_FORWARD(bignum_less)
|
||||
PRIMITIVE_FORWARD(bignum_lesseq)
|
||||
PRIMITIVE_FORWARD(bignum_greater)
|
||||
PRIMITIVE_FORWARD(bignum_greatereq)
|
||||
PRIMITIVE_FORWARD(bignum_bitp)
|
||||
PRIMITIVE_FORWARD(bignum_log2)
|
||||
PRIMITIVE_FORWARD(byte_array_to_bignum)
|
||||
PRIMITIVE_FORWARD(float_eq)
|
||||
PRIMITIVE_FORWARD(float_add)
|
||||
PRIMITIVE_FORWARD(float_subtract)
|
||||
PRIMITIVE_FORWARD(float_multiply)
|
||||
PRIMITIVE_FORWARD(float_divfloat)
|
||||
PRIMITIVE_FORWARD(float_mod)
|
||||
PRIMITIVE_FORWARD(float_less)
|
||||
PRIMITIVE_FORWARD(float_lesseq)
|
||||
PRIMITIVE_FORWARD(float_greater)
|
||||
PRIMITIVE_FORWARD(float_greatereq)
|
||||
PRIMITIVE_FORWARD(word)
|
||||
PRIMITIVE_FORWARD(word_xt)
|
||||
PRIMITIVE_FORWARD(getenv)
|
||||
PRIMITIVE_FORWARD(setenv)
|
||||
PRIMITIVE_FORWARD(existsp)
|
||||
PRIMITIVE_FORWARD(gc)
|
||||
PRIMITIVE_FORWARD(gc_stats)
|
||||
PRIMITIVE_FORWARD(save_image)
|
||||
PRIMITIVE_FORWARD(save_image_and_exit)
|
||||
PRIMITIVE_FORWARD(datastack)
|
||||
PRIMITIVE_FORWARD(retainstack)
|
||||
PRIMITIVE_FORWARD(callstack)
|
||||
PRIMITIVE_FORWARD(set_datastack)
|
||||
PRIMITIVE_FORWARD(set_retainstack)
|
||||
PRIMITIVE_FORWARD(set_callstack)
|
||||
PRIMITIVE_FORWARD(exit)
|
||||
PRIMITIVE_FORWARD(data_room)
|
||||
PRIMITIVE_FORWARD(code_room)
|
||||
PRIMITIVE_FORWARD(micros)
|
||||
PRIMITIVE_FORWARD(modify_code_heap)
|
||||
PRIMITIVE_FORWARD(dlopen)
|
||||
PRIMITIVE_FORWARD(dlsym)
|
||||
PRIMITIVE_FORWARD(dlclose)
|
||||
PRIMITIVE_FORWARD(byte_array)
|
||||
PRIMITIVE_FORWARD(uninitialized_byte_array)
|
||||
PRIMITIVE_FORWARD(displaced_alien)
|
||||
PRIMITIVE_FORWARD(alien_address)
|
||||
PRIMITIVE_FORWARD(set_slot)
|
||||
PRIMITIVE_FORWARD(string_nth)
|
||||
PRIMITIVE_FORWARD(set_string_nth_fast)
|
||||
PRIMITIVE_FORWARD(set_string_nth_slow)
|
||||
PRIMITIVE_FORWARD(resize_array)
|
||||
PRIMITIVE_FORWARD(resize_string)
|
||||
PRIMITIVE_FORWARD(array)
|
||||
PRIMITIVE_FORWARD(begin_scan)
|
||||
PRIMITIVE_FORWARD(next_object)
|
||||
PRIMITIVE_FORWARD(end_scan)
|
||||
PRIMITIVE_FORWARD(size)
|
||||
PRIMITIVE_FORWARD(die)
|
||||
PRIMITIVE_FORWARD(fopen)
|
||||
PRIMITIVE_FORWARD(fgetc)
|
||||
PRIMITIVE_FORWARD(fread)
|
||||
PRIMITIVE_FORWARD(fputc)
|
||||
PRIMITIVE_FORWARD(fwrite)
|
||||
PRIMITIVE_FORWARD(fflush)
|
||||
PRIMITIVE_FORWARD(ftell)
|
||||
PRIMITIVE_FORWARD(fseek)
|
||||
PRIMITIVE_FORWARD(fclose)
|
||||
PRIMITIVE_FORWARD(wrapper)
|
||||
PRIMITIVE_FORWARD(clone)
|
||||
PRIMITIVE_FORWARD(string)
|
||||
PRIMITIVE_FORWARD(array_to_quotation)
|
||||
PRIMITIVE_FORWARD(quotation_xt)
|
||||
PRIMITIVE_FORWARD(tuple)
|
||||
PRIMITIVE_FORWARD(profiling)
|
||||
PRIMITIVE_FORWARD(become)
|
||||
PRIMITIVE_FORWARD(sleep)
|
||||
PRIMITIVE_FORWARD(tuple_boa)
|
||||
PRIMITIVE_FORWARD(callstack_to_array)
|
||||
PRIMITIVE_FORWARD(innermost_stack_frame_executing)
|
||||
PRIMITIVE_FORWARD(innermost_stack_frame_scan)
|
||||
PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
|
||||
PRIMITIVE_FORWARD(call_clear)
|
||||
PRIMITIVE_FORWARD(resize_byte_array)
|
||||
PRIMITIVE_FORWARD(dll_validp)
|
||||
PRIMITIVE_FORWARD(unimplemented)
|
||||
PRIMITIVE_FORWARD(clear_gc_stats)
|
||||
PRIMITIVE_FORWARD(jit_compile)
|
||||
PRIMITIVE_FORWARD(load_locals)
|
||||
PRIMITIVE_FORWARD(check_datastack)
|
||||
PRIMITIVE_FORWARD(mega_cache_miss)
|
||||
PRIMITIVE_FORWARD(lookup_method)
|
||||
PRIMITIVE_FORWARD(reset_dispatch_stats)
|
||||
PRIMITIVE_FORWARD(dispatch_stats)
|
||||
PRIMITIVE_FORWARD(reset_inline_cache_stats)
|
||||
PRIMITIVE_FORWARD(inline_cache_stats)
|
||||
PRIMITIVE_FORWARD(optimized_p)
|
||||
PRIMITIVE_FORWARD(quot_compiled_p)
|
||||
PRIMITIVE_FORWARD(vm_ptr)
|
||||
PRIMITIVE_FORWARD(strip_stack_traces)
|
||||
|
||||
}
|
||||
|
|
|
@ -6,91 +6,26 @@ namespace factor
|
|||
#define PRIMITIVE(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm)
|
||||
#define PRIMITIVE_FORWARD(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm) \
|
||||
{ \
|
||||
PRIMITIVE_GETVM()->primitive_##name(); \
|
||||
((factor_vm*)myvm)->primitive_##name(); \
|
||||
}
|
||||
#else
|
||||
extern "C" typedef void (*primitive_type)(void *myvm);
|
||||
#define PRIMITIVE(name) extern "C" void primitive_##name(void *myvm)
|
||||
#define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(void *myvm) \
|
||||
{ \
|
||||
PRIMITIVE_GETVM()->primitive_##name(); \
|
||||
((factor_vm*)myvm)->primitive_##name(); \
|
||||
}
|
||||
#endif
|
||||
extern const primitive_type primitives[];
|
||||
|
||||
PRIMITIVE(bignum_to_fixnum);
|
||||
PRIMITIVE(float_to_fixnum);
|
||||
PRIMITIVE(fixnum_to_bignum);
|
||||
PRIMITIVE(float_to_bignum);
|
||||
PRIMITIVE(fixnum_to_float);
|
||||
PRIMITIVE(bignum_to_float);
|
||||
PRIMITIVE(str_to_float);
|
||||
PRIMITIVE(float_to_str);
|
||||
PRIMITIVE(float_bits);
|
||||
PRIMITIVE(double_bits);
|
||||
PRIMITIVE(bits_float);
|
||||
PRIMITIVE(bits_double);
|
||||
/* These are defined in assembly */
|
||||
PRIMITIVE(fixnum_add);
|
||||
PRIMITIVE(fixnum_subtract);
|
||||
PRIMITIVE(fixnum_multiply);
|
||||
PRIMITIVE(fixnum_divint);
|
||||
PRIMITIVE(fixnum_divmod);
|
||||
PRIMITIVE(fixnum_shift);
|
||||
PRIMITIVE(bignum_eq);
|
||||
PRIMITIVE(bignum_add);
|
||||
PRIMITIVE(bignum_subtract);
|
||||
PRIMITIVE(bignum_multiply);
|
||||
PRIMITIVE(bignum_divint);
|
||||
PRIMITIVE(bignum_mod);
|
||||
PRIMITIVE(bignum_divmod);
|
||||
PRIMITIVE(bignum_and);
|
||||
PRIMITIVE(bignum_or);
|
||||
PRIMITIVE(bignum_xor);
|
||||
PRIMITIVE(bignum_not);
|
||||
PRIMITIVE(bignum_shift);
|
||||
PRIMITIVE(bignum_less);
|
||||
PRIMITIVE(bignum_lesseq);
|
||||
PRIMITIVE(bignum_greater);
|
||||
PRIMITIVE(bignum_greatereq);
|
||||
PRIMITIVE(bignum_bitp);
|
||||
PRIMITIVE(bignum_log2);
|
||||
PRIMITIVE(byte_array_to_bignum);
|
||||
PRIMITIVE(float_eq);
|
||||
PRIMITIVE(float_add);
|
||||
PRIMITIVE(float_subtract);
|
||||
PRIMITIVE(float_multiply);
|
||||
PRIMITIVE(float_divfloat);
|
||||
PRIMITIVE(float_mod);
|
||||
PRIMITIVE(float_less);
|
||||
PRIMITIVE(float_lesseq);
|
||||
PRIMITIVE(float_greater);
|
||||
PRIMITIVE(float_greatereq);
|
||||
PRIMITIVE(word);
|
||||
PRIMITIVE(word_xt);
|
||||
PRIMITIVE(getenv);
|
||||
PRIMITIVE(setenv);
|
||||
PRIMITIVE(existsp);
|
||||
PRIMITIVE(gc);
|
||||
PRIMITIVE(gc_stats);
|
||||
PRIMITIVE(save_image);
|
||||
PRIMITIVE(save_image_and_exit);
|
||||
PRIMITIVE(datastack);
|
||||
PRIMITIVE(retainstack);
|
||||
PRIMITIVE(callstack);
|
||||
PRIMITIVE(set_datastack);
|
||||
PRIMITIVE(set_retainstack);
|
||||
PRIMITIVE(set_callstack);
|
||||
PRIMITIVE(exit);
|
||||
PRIMITIVE(data_room);
|
||||
PRIMITIVE(code_room);
|
||||
PRIMITIVE(micros);
|
||||
PRIMITIVE(modify_code_heap);
|
||||
PRIMITIVE(dlopen);
|
||||
PRIMITIVE(dlsym);
|
||||
PRIMITIVE(dlclose);
|
||||
PRIMITIVE(byte_array);
|
||||
PRIMITIVE(uninitialized_byte_array);
|
||||
PRIMITIVE(displaced_alien);
|
||||
PRIMITIVE(inline_cache_miss);
|
||||
PRIMITIVE(inline_cache_miss_tail);
|
||||
|
||||
/* These are generated with macros in alien.c */
|
||||
PRIMITIVE(alien_signed_cell);
|
||||
PRIMITIVE(set_alien_signed_cell);
|
||||
PRIMITIVE(alien_unsigned_cell);
|
||||
|
@ -117,61 +52,5 @@ PRIMITIVE(alien_double);
|
|||
PRIMITIVE(set_alien_double);
|
||||
PRIMITIVE(alien_cell);
|
||||
PRIMITIVE(set_alien_cell);
|
||||
PRIMITIVE(alien_address);
|
||||
PRIMITIVE(set_slot);
|
||||
PRIMITIVE(string_nth);
|
||||
PRIMITIVE(set_string_nth_fast);
|
||||
PRIMITIVE(set_string_nth_slow);
|
||||
PRIMITIVE(resize_array);
|
||||
PRIMITIVE(resize_string);
|
||||
PRIMITIVE(array);
|
||||
PRIMITIVE(begin_scan);
|
||||
PRIMITIVE(next_object);
|
||||
PRIMITIVE(end_scan);
|
||||
PRIMITIVE(size);
|
||||
PRIMITIVE(die);
|
||||
PRIMITIVE(fopen);
|
||||
PRIMITIVE(fgetc);
|
||||
PRIMITIVE(fread);
|
||||
PRIMITIVE(fputc);
|
||||
PRIMITIVE(fwrite);
|
||||
PRIMITIVE(fflush);
|
||||
PRIMITIVE(ftell);
|
||||
PRIMITIVE(fseek);
|
||||
PRIMITIVE(fclose);
|
||||
PRIMITIVE(wrapper);
|
||||
PRIMITIVE(clone);
|
||||
PRIMITIVE(string);
|
||||
PRIMITIVE(array_to_quotation);
|
||||
PRIMITIVE(quotation_xt);
|
||||
PRIMITIVE(tuple);
|
||||
PRIMITIVE(profiling);
|
||||
PRIMITIVE(become);
|
||||
PRIMITIVE(sleep);
|
||||
PRIMITIVE(tuple_boa);
|
||||
PRIMITIVE(callstack_to_array);
|
||||
PRIMITIVE(innermost_stack_frame_executing);
|
||||
PRIMITIVE(innermost_stack_frame_scan);
|
||||
PRIMITIVE(set_innermost_stack_frame_quot);
|
||||
PRIMITIVE(call_clear);
|
||||
PRIMITIVE(resize_byte_array);
|
||||
PRIMITIVE(dll_validp);
|
||||
PRIMITIVE(unimplemented);
|
||||
PRIMITIVE(clear_gc_stats);
|
||||
PRIMITIVE(jit_compile);
|
||||
PRIMITIVE(load_locals);
|
||||
PRIMITIVE(check_datastack);
|
||||
PRIMITIVE(inline_cache_miss);
|
||||
PRIMITIVE(inline_cache_miss_tail);
|
||||
PRIMITIVE(mega_cache_miss);
|
||||
PRIMITIVE(lookup_method);
|
||||
PRIMITIVE(reset_dispatch_stats);
|
||||
PRIMITIVE(dispatch_stats);
|
||||
PRIMITIVE(reset_inline_cache_stats);
|
||||
PRIMITIVE(inline_cache_stats);
|
||||
PRIMITIVE(optimized_p);
|
||||
PRIMITIVE(quot_compiled_p);
|
||||
PRIMITIVE(vm_ptr);
|
||||
PRIMITIVE(strip_stack_traces);
|
||||
|
||||
}
|
||||
|
|
|
@ -29,7 +29,7 @@ void factor_vm::set_profiling(bool profiling)
|
|||
|
||||
/* Push everything to tenured space so that we can heap scan
|
||||
and allocate profiling blocks if necessary */
|
||||
gc();
|
||||
primitive_full_gc();
|
||||
|
||||
gc_root<array> words(find_all_words(),this);
|
||||
|
||||
|
|
|
@ -283,9 +283,7 @@ void quotation_jit::iterate_quotation()
|
|||
|
||||
void factor_vm::set_quot_xt(quotation *quot, code_block *code)
|
||||
{
|
||||
if(code->type() != QUOTATION_TYPE)
|
||||
critical_error("Bad param to set_quot_xt",(cell)code);
|
||||
|
||||
assert(code->type() == QUOTATION_TYPE);
|
||||
quot->code = code;
|
||||
quot->xt = code->xt();
|
||||
}
|
||||
|
@ -364,15 +362,14 @@ 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<quotation> quot(quot_,this);
|
||||
stack_chain->callstack_top = stack;
|
||||
ctx->callstack_top = stack;
|
||||
jit_compile(quot.value(),true);
|
||||
return quot.value();
|
||||
}
|
||||
|
||||
VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->lazy_jit_compile_impl(quot_,stack);
|
||||
return myvm->lazy_jit_compile_impl(quot_,stack);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_quot_compiled_p()
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -13,7 +13,7 @@ struct segment {
|
|||
cell size;
|
||||
cell end;
|
||||
|
||||
explicit segment(cell size);
|
||||
explicit segment(cell size, bool executable_p);
|
||||
~segment();
|
||||
};
|
||||
|
||||
|
|
|
@ -37,13 +37,13 @@ struct tagged
|
|||
|
||||
explicit tagged(cell tagged) : value_(tagged) {
|
||||
#ifdef FACTOR_DEBUG
|
||||
untag_check(SIGNAL_VM_PTR());
|
||||
untag_check(tls_vm());
|
||||
#endif
|
||||
}
|
||||
|
||||
explicit tagged(Type *untagged) : value_(factor::tag(untagged)) {
|
||||
#ifdef FACTOR_DEBUG
|
||||
untag_check(SIGNAL_VM_PTR());
|
||||
untag_check(tls_vm());
|
||||
#endif
|
||||
}
|
||||
|
||||
|
|
|
@ -12,6 +12,7 @@ to_tenured_collector::to_tenured_collector(factor_vm *myvm_) :
|
|||
|
||||
void factor_vm::collect_to_tenured()
|
||||
{
|
||||
/* Copy live objects from aging space to tenured space. */
|
||||
to_tenured_collector collector(this);
|
||||
|
||||
collector.trace_roots();
|
||||
|
|
|
@ -15,7 +15,6 @@ struct to_tenured_policy {
|
|||
|
||||
struct to_tenured_collector : copying_collector<tenured_space,to_tenured_policy> {
|
||||
to_tenured_collector(factor_vm *myvm_);
|
||||
void go();
|
||||
};
|
||||
|
||||
}
|
||||
|
|
86
vm/vm.hpp
86
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<typename Iterator> 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,14 +253,16 @@ struct factor_vm
|
|||
void collect_nursery();
|
||||
void collect_aging();
|
||||
void collect_to_tenured();
|
||||
void update_code_heap_for_full_gc(bool growing_data_heap);
|
||||
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);
|
||||
void collect_full(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 garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes);
|
||||
void gc();
|
||||
void primitive_gc();
|
||||
void gc(gc_op op, cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p);
|
||||
void primitive_minor_gc();
|
||||
void primitive_full_gc();
|
||||
void primitive_compact_gc();
|
||||
void primitive_gc_stats();
|
||||
void clear_gc_stats();
|
||||
void primitive_become();
|
||||
|
@ -500,10 +517,10 @@ struct factor_vm
|
|||
void update_code_heap_words();
|
||||
void primitive_modify_code_heap();
|
||||
void primitive_code_room();
|
||||
code_block *forward_xt(code_block *compiled);
|
||||
void forward_object_xts();
|
||||
void fixup_object_xts();
|
||||
void compact_code_heap();
|
||||
void forward_context_xts();
|
||||
void forward_callback_xts();
|
||||
void compact_code_heap(bool trace_contexts_p);
|
||||
void primitive_strip_stack_traces();
|
||||
|
||||
/* Apply a function to every code block */
|
||||
|
@ -519,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);
|
||||
|
@ -558,7 +579,7 @@ struct factor_vm
|
|||
void primitive_innermost_stack_frame_scan();
|
||||
void primitive_set_innermost_stack_frame_quot();
|
||||
void save_callstack_bottom(stack_frame *callstack_bottom);
|
||||
template<typename Iterator> void iterate_callstack(cell top, cell bottom, Iterator &iterator);
|
||||
template<typename Iterator> void iterate_callstack(context *ctx, Iterator &iterator);
|
||||
|
||||
/* 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
|
||||
|
@ -691,47 +712,6 @@ struct factor_vm
|
|||
|
||||
};
|
||||
|
||||
#ifndef FACTOR_REENTRANT
|
||||
#define FACTOR_SINGLE_THREADED_TESTING
|
||||
#endif
|
||||
|
||||
#ifdef FACTOR_SINGLE_THREADED_SINGLETON
|
||||
/* calls are dispatched using the singleton vm ptr */
|
||||
extern factor_vm *vm;
|
||||
#define PRIMITIVE_GETVM() vm
|
||||
#define PRIMITIVE_OVERFLOW_GETVM() vm
|
||||
#define VM_PTR vm
|
||||
#define ASSERTVM()
|
||||
#define SIGNAL_VM_PTR() vm
|
||||
#endif
|
||||
|
||||
#ifdef FACTOR_SINGLE_THREADED_TESTING
|
||||
/* calls are dispatched as per multithreaded, but checked against singleton */
|
||||
extern factor_vm *vm;
|
||||
#define ASSERTVM() assert(vm==myvm)
|
||||
#define PRIMITIVE_GETVM() ((factor_vm*)myvm)
|
||||
#define PRIMITIVE_OVERFLOW_GETVM() ASSERTVM(); myvm
|
||||
#define VM_PTR myvm
|
||||
#define SIGNAL_VM_PTR() tls_vm()
|
||||
#endif
|
||||
|
||||
#ifdef FACTOR_REENTRANT_TLS
|
||||
/* uses thread local storage to obtain vm ptr */
|
||||
#define PRIMITIVE_GETVM() tls_vm()
|
||||
#define PRIMITIVE_OVERFLOW_GETVM() tls_vm()
|
||||
#define VM_PTR tls_vm()
|
||||
#define ASSERTVM()
|
||||
#define SIGNAL_VM_PTR() tls_vm()
|
||||
#endif
|
||||
|
||||
#ifdef FACTOR_REENTRANT
|
||||
#define PRIMITIVE_GETVM() ((factor_vm*)myvm)
|
||||
#define PRIMITIVE_OVERFLOW_GETVM() ((factor_vm*)myvm)
|
||||
#define VM_PTR myvm
|
||||
#define ASSERTVM()
|
||||
#define SIGNAL_VM_PTR() tls_vm()
|
||||
#endif
|
||||
|
||||
extern unordered_map<THREADHANDLE, factor_vm *> thread_vms;
|
||||
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue