Merge branch 'reentrantvm' of git://github.com/phildawes/factor
commit
2c136d6536
|
@ -51,8 +51,9 @@ CONSTANT: rs-reg 14
|
|||
0 3 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel
|
||||
4 3 0 LWZ
|
||||
1 4 0 STW
|
||||
0 3 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel
|
||||
3 MTCTR
|
||||
4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
|
||||
0 5 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel
|
||||
5 MTCTR
|
||||
BCTR
|
||||
] jit-primitive jit-define
|
||||
|
||||
|
@ -254,8 +255,9 @@ CONSTANT: rs-reg 14
|
|||
[
|
||||
3 ds-reg 0 LWZ
|
||||
ds-reg dup 4 SUBI
|
||||
4 3 quot-xt-offset LWZ
|
||||
4 MTCTR
|
||||
4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
|
||||
5 3 quot-xt-offset LWZ
|
||||
5 MTCTR
|
||||
BCTR
|
||||
] \ (call) define-sub-primitive
|
||||
|
||||
|
|
|
@ -462,6 +462,7 @@ M:: ppc %load-gc-root ( gc-root register -- )
|
|||
M:: ppc %call-gc ( gc-root-count temp -- )
|
||||
3 1 gc-root-base local@ ADDI
|
||||
gc-root-count 4 LI
|
||||
5 %load-vm-addr
|
||||
"inline_gc" f %alien-invoke ;
|
||||
|
||||
M: ppc %prologue ( n -- )
|
||||
|
@ -610,6 +611,7 @@ M: ppc %prepare-unbox ( -- )
|
|||
|
||||
M: ppc %unbox ( n rep func -- )
|
||||
! Value must be in r3
|
||||
4 %load-vm-addr
|
||||
! Call the unboxer
|
||||
f %alien-invoke
|
||||
! Store the return value on the C stack
|
||||
|
@ -617,6 +619,7 @@ M: ppc %unbox ( n rep func -- )
|
|||
|
||||
M: ppc %unbox-long-long ( n func -- )
|
||||
! Value must be in r3:r4
|
||||
4 %load-vm-addr
|
||||
! Call the unboxer
|
||||
f %alien-invoke
|
||||
! Store the return value on the C stack
|
||||
|
@ -629,15 +632,17 @@ M: ppc %unbox-large-struct ( n c-type -- )
|
|||
! Value must be in r3
|
||||
! Compute destination address and load struct size
|
||||
[ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi*
|
||||
6 %load-vm-addr
|
||||
! Call the function
|
||||
"to_value_struct" f %alien-invoke ;
|
||||
|
||||
M: ppc %box ( n rep func -- )
|
||||
M:: ppc %box ( n rep func -- )
|
||||
! If the source is a stack location, load it into freg #0.
|
||||
! If the source is f, then we assume the value is already in
|
||||
! freg #0.
|
||||
[ over [ 0 over reg-class-of param-reg swap %load-param-reg ] [ 2drop ] if ] dip
|
||||
f %alien-invoke ;
|
||||
n [ 0 rep reg-class-of param-reg rep %load-param-reg ] when*
|
||||
rep double-rep? 5 4 ? %load-vm-addr
|
||||
func f %alien-invoke ;
|
||||
|
||||
M: ppc %box-long-long ( n func -- )
|
||||
[
|
||||
|
@ -645,6 +650,7 @@ M: ppc %box-long-long ( n func -- )
|
|||
[ [ 3 1 ] dip local@ LWZ ]
|
||||
[ [ 4 1 ] dip cell + local@ LWZ ] bi
|
||||
] when*
|
||||
5 %load-vm-addr
|
||||
] dip f %alien-invoke ;
|
||||
|
||||
: struct-return@ ( n -- n )
|
||||
|
@ -659,6 +665,7 @@ M: ppc %box-large-struct ( n c-type -- )
|
|||
! If n = f, then we're boxing a returned struct
|
||||
! Compute destination address and load struct size
|
||||
[ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
|
||||
5 %load-vm-addr
|
||||
! Call the function
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
|
||||
|
@ -678,9 +685,12 @@ M: ppc %alien-invoke ( symbol dll -- )
|
|||
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
|
||||
|
||||
M: ppc %alien-callback ( quot -- )
|
||||
3 swap %load-reference "c_to_factor" f %alien-invoke ;
|
||||
3 swap %load-reference
|
||||
4 %load-vm-addr
|
||||
"c_to_factor" f %alien-invoke ;
|
||||
|
||||
M: ppc %prepare-alien-indirect ( -- )
|
||||
3 %load-vm-addr
|
||||
"unbox_alien" f %alien-invoke
|
||||
15 3 MR ;
|
||||
|
||||
|
@ -691,6 +701,7 @@ M: ppc %callback-value ( ctype -- )
|
|||
! Save top of data stack
|
||||
3 ds-reg 0 LWZ
|
||||
3 1 0 local@ STW
|
||||
3 %load-vm-addr
|
||||
! Restore data/call/retain stacks
|
||||
"unnest_stacks" f %alien-invoke
|
||||
! Restore top of data stack
|
||||
|
@ -706,21 +717,25 @@ M: ppc return-struct-in-registers? ( c-type -- ? )
|
|||
M: ppc %box-small-struct ( c-type -- )
|
||||
#! Box a <= 16-byte struct returned in r3:r4:r5:r6
|
||||
heap-size 7 LI
|
||||
8 %load-vm-addr
|
||||
"box_medium_struct" f %alien-invoke ;
|
||||
|
||||
: %unbox-struct-1 ( -- )
|
||||
! Alien must be in r3.
|
||||
4 %load-vm-addr
|
||||
"alien_offset" f %alien-invoke
|
||||
3 3 0 LWZ ;
|
||||
|
||||
: %unbox-struct-2 ( -- )
|
||||
! Alien must be in r3.
|
||||
4 %load-vm-addr
|
||||
"alien_offset" f %alien-invoke
|
||||
4 3 4 LWZ
|
||||
3 3 0 LWZ ;
|
||||
|
||||
: %unbox-struct-4 ( -- )
|
||||
! Alien must be in r3.
|
||||
4 %load-vm-addr
|
||||
"alien_offset" f %alien-invoke
|
||||
6 3 12 LWZ
|
||||
5 3 8 LWZ
|
||||
|
@ -728,9 +743,11 @@ M: ppc %box-small-struct ( c-type -- )
|
|||
3 3 0 LWZ ;
|
||||
|
||||
M: ppc %nest-stacks ( -- )
|
||||
3 %load-vm-addr
|
||||
"nest_stacks" f %alien-invoke ;
|
||||
|
||||
M: ppc %unnest-stacks ( -- )
|
||||
3 %load-vm-addr
|
||||
"unnest_stacks" f %alien-invoke ;
|
||||
|
||||
M: ppc %unbox-small-struct ( size -- )
|
||||
|
|
28
vm/alien.cpp
28
vm/alien.cpp
|
@ -46,7 +46,7 @@ cell factor_vm::allot_alien(cell delegate_, cell displacement)
|
|||
}
|
||||
|
||||
/* make an alien pointing at an offset of another alien */
|
||||
inline void factor_vm::primitive_displaced_alien()
|
||||
void factor_vm::primitive_displaced_alien()
|
||||
{
|
||||
cell alien = dpop();
|
||||
cell displacement = to_cell(dpop());
|
||||
|
@ -69,17 +69,13 @@ inline void factor_vm::primitive_displaced_alien()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(displaced_alien)
|
||||
|
||||
/* address of an object representing a C pointer. Explicitly throw an error
|
||||
if the object is a byte array, as a sanity check. */
|
||||
inline void factor_vm::primitive_alien_address()
|
||||
void factor_vm::primitive_alien_address()
|
||||
{
|
||||
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(alien_address)
|
||||
|
||||
/* pop ( alien n ) from datastack, return alien's address plus n */
|
||||
void *factor_vm::alien_pointer()
|
||||
{
|
||||
|
@ -115,7 +111,7 @@ DEFINE_ALIEN_ACCESSOR(double,double,box_double,to_double)
|
|||
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
|
||||
|
||||
/* open a native library and push a handle */
|
||||
inline void factor_vm::primitive_dlopen()
|
||||
void factor_vm::primitive_dlopen()
|
||||
{
|
||||
gc_root<byte_array> path(dpop(),this);
|
||||
path.untag_check(this);
|
||||
|
@ -125,10 +121,8 @@ inline void factor_vm::primitive_dlopen()
|
|||
dpush(library.value());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(dlopen)
|
||||
|
||||
/* look up a symbol in a native library */
|
||||
inline void factor_vm::primitive_dlsym()
|
||||
void factor_vm::primitive_dlsym()
|
||||
{
|
||||
gc_root<object> library(dpop(),this);
|
||||
gc_root<byte_array> name(dpop(),this);
|
||||
|
@ -149,19 +143,15 @@ inline void factor_vm::primitive_dlsym()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(dlsym)
|
||||
|
||||
/* close a native library handle */
|
||||
inline void factor_vm::primitive_dlclose()
|
||||
void factor_vm::primitive_dlclose()
|
||||
{
|
||||
dll *d = untag_check<dll>(dpop());
|
||||
if(d->dll != NULL)
|
||||
ffi_dlclose(d);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(dlclose)
|
||||
|
||||
inline void factor_vm::primitive_dll_validp()
|
||||
void factor_vm::primitive_dll_validp()
|
||||
{
|
||||
cell library = dpop();
|
||||
if(library == F)
|
||||
|
@ -170,8 +160,6 @@ inline void factor_vm::primitive_dll_validp()
|
|||
dpush(untag_check<dll>(library)->dll == NULL ? F : T);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(dll_validp)
|
||||
|
||||
/* gets the address of an object representing a C pointer */
|
||||
char *factor_vm::alien_offset(cell obj)
|
||||
{
|
||||
|
@ -285,11 +273,9 @@ VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, f
|
|||
return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_vm_ptr()
|
||||
void factor_vm::primitive_vm_ptr()
|
||||
{
|
||||
box_alien(this);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(vm_ptr)
|
||||
|
||||
}
|
||||
|
|
37
vm/alien.hpp
37
vm/alien.hpp
|
@ -1,43 +1,6 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE(displaced_alien);
|
||||
PRIMITIVE(alien_address);
|
||||
|
||||
PRIMITIVE(alien_signed_cell);
|
||||
PRIMITIVE(set_alien_signed_cell);
|
||||
PRIMITIVE(alien_unsigned_cell);
|
||||
PRIMITIVE(set_alien_unsigned_cell);
|
||||
PRIMITIVE(alien_signed_8);
|
||||
PRIMITIVE(set_alien_signed_8);
|
||||
PRIMITIVE(alien_unsigned_8);
|
||||
PRIMITIVE(set_alien_unsigned_8);
|
||||
PRIMITIVE(alien_signed_4);
|
||||
PRIMITIVE(set_alien_signed_4);
|
||||
PRIMITIVE(alien_unsigned_4);
|
||||
PRIMITIVE(set_alien_unsigned_4);
|
||||
PRIMITIVE(alien_signed_2);
|
||||
PRIMITIVE(set_alien_signed_2);
|
||||
PRIMITIVE(alien_unsigned_2);
|
||||
PRIMITIVE(set_alien_unsigned_2);
|
||||
PRIMITIVE(alien_signed_1);
|
||||
PRIMITIVE(set_alien_signed_1);
|
||||
PRIMITIVE(alien_unsigned_1);
|
||||
PRIMITIVE(set_alien_unsigned_1);
|
||||
PRIMITIVE(alien_float);
|
||||
PRIMITIVE(set_alien_float);
|
||||
PRIMITIVE(alien_double);
|
||||
PRIMITIVE(set_alien_double);
|
||||
PRIMITIVE(alien_cell);
|
||||
PRIMITIVE(set_alien_cell);
|
||||
|
||||
PRIMITIVE(dlopen);
|
||||
PRIMITIVE(dlsym);
|
||||
PRIMITIVE(dlclose);
|
||||
PRIMITIVE(dll_validp);
|
||||
|
||||
PRIMITIVE(vm_ptr);
|
||||
|
||||
VM_C_API char *alien_offset(cell object, factor_vm *vm);
|
||||
VM_C_API char *unbox_alien(factor_vm *vm);
|
||||
VM_C_API void box_alien(void *ptr, factor_vm *vm);
|
||||
|
|
|
@ -24,15 +24,13 @@ array *factor_vm::allot_array(cell capacity, cell fill_)
|
|||
}
|
||||
|
||||
/* push a new array on the stack */
|
||||
inline void factor_vm::primitive_array()
|
||||
void factor_vm::primitive_array()
|
||||
{
|
||||
cell initial = dpop();
|
||||
cell size = unbox_array_size();
|
||||
dpush(tag<array>(allot_array(size,initial)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(array)
|
||||
|
||||
cell factor_vm::allot_array_1(cell obj_)
|
||||
{
|
||||
gc_root<object> obj(obj_,this);
|
||||
|
@ -65,15 +63,13 @@ cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
|||
return a.value();
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_resize_array()
|
||||
void factor_vm::primitive_resize_array()
|
||||
{
|
||||
array* a = untag_check<array>(dpop());
|
||||
cell capacity = unbox_array_size();
|
||||
dpush(tag<array>(reallot_array(a,capacity)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(resize_array)
|
||||
|
||||
void growable_array::add(cell elt_)
|
||||
{
|
||||
factor_vm* parent_vm = elements.parent_vm;
|
||||
|
|
|
@ -10,7 +10,25 @@ inline cell array_nth(array *array, cell slot)
|
|||
return array->data()[slot];
|
||||
}
|
||||
|
||||
PRIMITIVE(array);
|
||||
PRIMITIVE(resize_array);
|
||||
inline void factor_vm::set_array_nth(array *array, cell slot, cell value)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(slot < array_capacity(array));
|
||||
assert(array->h.hi_tag() == ARRAY_TYPE);
|
||||
check_tagged_pointer(value);
|
||||
#endif
|
||||
array->data()[slot] = value;
|
||||
write_barrier(array);
|
||||
}
|
||||
|
||||
struct growable_array {
|
||||
cell count;
|
||||
gc_root<array> elements;
|
||||
|
||||
growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
|
||||
|
||||
void add(cell elt);
|
||||
void trim();
|
||||
};
|
||||
|
||||
}
|
||||
|
|
|
@ -365,7 +365,6 @@ FOO_TO_BIGNUM(fixnum,fixnum,cell)
|
|||
FOO_TO_BIGNUM(long_long,s64,u64)
|
||||
FOO_TO_BIGNUM(ulong_long,u64,u64)
|
||||
|
||||
|
||||
#define BIGNUM_TO_FOO(name,type,utype) \
|
||||
type factor_vm::bignum_to_##name(bignum * bignum) \
|
||||
{ \
|
||||
|
|
|
@ -4,4 +4,9 @@ namespace factor
|
|||
VM_C_API void box_boolean(bool value, factor_vm *vm);
|
||||
VM_C_API bool to_boolean(cell value, factor_vm *vm);
|
||||
|
||||
inline cell factor_vm::tag_boolean(cell untagged)
|
||||
{
|
||||
return (untagged ? T : F);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -10,31 +10,25 @@ byte_array *factor_vm::allot_byte_array(cell size)
|
|||
return array;
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_byte_array()
|
||||
void factor_vm::primitive_byte_array()
|
||||
{
|
||||
cell size = unbox_array_size();
|
||||
dpush(tag<byte_array>(allot_byte_array(size)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(byte_array)
|
||||
|
||||
inline void factor_vm::primitive_uninitialized_byte_array()
|
||||
void factor_vm::primitive_uninitialized_byte_array()
|
||||
{
|
||||
cell size = unbox_array_size();
|
||||
dpush(tag<byte_array>(allot_array_internal<byte_array>(size)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(uninitialized_byte_array)
|
||||
|
||||
inline void factor_vm::primitive_resize_byte_array()
|
||||
void factor_vm::primitive_resize_byte_array()
|
||||
{
|
||||
byte_array *array = untag_check<byte_array>(dpop());
|
||||
cell capacity = unbox_array_size();
|
||||
dpush(tag<byte_array>(reallot_array(array,capacity)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(resize_byte_array)
|
||||
|
||||
void growable_byte_array::append_bytes(void *elts, cell len)
|
||||
{
|
||||
cell new_size = count + len;
|
||||
|
|
|
@ -1,8 +1,16 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE(byte_array);
|
||||
PRIMITIVE(uninitialized_byte_array);
|
||||
PRIMITIVE(resize_byte_array);
|
||||
struct growable_byte_array {
|
||||
cell count;
|
||||
gc_root<byte_array> elements;
|
||||
|
||||
growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
|
||||
|
||||
void append_bytes(void *elts, cell len);
|
||||
void append_byte_array(cell elts);
|
||||
|
||||
void trim();
|
||||
};
|
||||
|
||||
}
|
||||
|
|
|
@ -46,7 +46,7 @@ stack_frame *factor_vm::capture_start()
|
|||
return frame + 1;
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_callstack()
|
||||
void factor_vm::primitive_callstack()
|
||||
{
|
||||
stack_frame *top = capture_start();
|
||||
stack_frame *bottom = stack_chain->callstack_bottom;
|
||||
|
@ -60,9 +60,7 @@ inline void factor_vm::primitive_callstack()
|
|||
dpush(tag<callstack>(stack));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(callstack)
|
||||
|
||||
inline void factor_vm::primitive_set_callstack()
|
||||
void factor_vm::primitive_set_callstack()
|
||||
{
|
||||
callstack *stack = untag_check<callstack>(dpop());
|
||||
|
||||
|
@ -75,8 +73,6 @@ inline void factor_vm::primitive_set_callstack()
|
|||
critical_error("Bug in set_callstack()",0);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(set_callstack)
|
||||
|
||||
code_block *factor_vm::frame_code(stack_frame *frame)
|
||||
{
|
||||
check_frame(frame);
|
||||
|
@ -155,7 +151,7 @@ struct stack_frame_accumulator {
|
|||
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_callstack_to_array()
|
||||
void factor_vm::primitive_callstack_to_array()
|
||||
{
|
||||
gc_root<callstack> callstack(dpop(),this);
|
||||
|
||||
|
@ -166,8 +162,6 @@ inline void factor_vm::primitive_callstack_to_array()
|
|||
dpush(accum.frames.elements.value());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(callstack_to_array)
|
||||
|
||||
stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
|
||||
{
|
||||
stack_frame *top = stack->top();
|
||||
|
@ -189,21 +183,17 @@ stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
|
|||
|
||||
/* Some primitives implementing a limited form of callstack mutation.
|
||||
Used by the single stepper. */
|
||||
inline void factor_vm::primitive_innermost_stack_frame_executing()
|
||||
void factor_vm::primitive_innermost_stack_frame_executing()
|
||||
{
|
||||
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(innermost_stack_frame_executing)
|
||||
|
||||
inline void factor_vm::primitive_innermost_stack_frame_scan()
|
||||
void factor_vm::primitive_innermost_stack_frame_scan()
|
||||
{
|
||||
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(innermost_stack_frame_scan)
|
||||
|
||||
inline void factor_vm::primitive_set_innermost_stack_frame_quot()
|
||||
void factor_vm::primitive_set_innermost_stack_frame_quot()
|
||||
{
|
||||
gc_root<callstack> callstack(dpop(),this);
|
||||
gc_root<quotation> quot(dpop(),this);
|
||||
|
@ -219,8 +209,6 @@ inline void factor_vm::primitive_set_innermost_stack_frame_quot()
|
|||
FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
|
||||
|
||||
/* called before entry into Factor code. */
|
||||
void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
|
||||
{
|
||||
|
|
|
@ -6,14 +6,51 @@ inline static cell callstack_size(cell size)
|
|||
return sizeof(callstack) + size;
|
||||
}
|
||||
|
||||
PRIMITIVE(callstack);
|
||||
PRIMITIVE(set_callstack);
|
||||
PRIMITIVE(callstack_to_array);
|
||||
PRIMITIVE(innermost_stack_frame_executing);
|
||||
PRIMITIVE(innermost_stack_frame_scan);
|
||||
PRIMITIVE(set_innermost_stack_frame_quot);
|
||||
|
||||
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *vm);
|
||||
|
||||
/* This is a little tricky. The iterator may allocate memory, so we
|
||||
keep the callstack in a GC root and use relative offsets */
|
||||
template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
|
||||
{
|
||||
gc_root<callstack> stack(stack_,this);
|
||||
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
|
||||
|
||||
while(frame_offset >= 0)
|
||||
{
|
||||
stack_frame *frame = stack->frame_at(frame_offset);
|
||||
frame_offset -= frame->size;
|
||||
iterator(frame,this);
|
||||
}
|
||||
}
|
||||
|
||||
template<typename TYPE> void factor_vm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
|
||||
{
|
||||
stack_frame *frame = (stack_frame *)bottom - 1;
|
||||
|
||||
while((cell)frame >= top)
|
||||
{
|
||||
iterator(frame,this);
|
||||
frame = frame_successor(frame);
|
||||
}
|
||||
}
|
||||
|
||||
/* Every object has a regular representation in the runtime, which makes GC
|
||||
much simpler. Every slot of the object until binary_payload_start is a pointer
|
||||
to some other object. */
|
||||
struct factor_vm;
|
||||
inline void factor_vm::do_slots(cell obj, void (* iter)(cell *,factor_vm*))
|
||||
{
|
||||
cell scan = obj;
|
||||
cell payload_start = binary_payload_start((object *)obj);
|
||||
cell end = obj + payload_start;
|
||||
|
||||
scan += sizeof(cell);
|
||||
|
||||
while(scan < end)
|
||||
{
|
||||
iter((cell *)scan,this);
|
||||
scan += sizeof(cell);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -200,7 +200,7 @@ void factor_vm::iterate_relocations(code_block *compiled, relocation_iterator it
|
|||
for(cell i = 0; i < length; i++)
|
||||
{
|
||||
relocation_entry rel = relocation->data<relocation_entry>()[i];
|
||||
iter(rel,index,compiled,this);
|
||||
(this->*iter)(rel,index,compiled);
|
||||
index += number_of_parameters(relocation_type_of(rel));
|
||||
}
|
||||
}
|
||||
|
@ -291,7 +291,7 @@ void factor_vm::update_literal_references(code_block *compiled)
|
|||
{
|
||||
if(!compiled->needs_fixup)
|
||||
{
|
||||
iterate_relocations(compiled,factor::update_literal_references_step);
|
||||
iterate_relocations(compiled,&factor_vm::update_literal_references_step);
|
||||
flush_icache_for(compiled);
|
||||
}
|
||||
}
|
||||
|
@ -321,11 +321,6 @@ void factor_vm::copy_literal_references(code_block *compiled)
|
|||
}
|
||||
}
|
||||
|
||||
void copy_literal_references(code_block *compiled, factor_vm *myvm)
|
||||
{
|
||||
return myvm->copy_literal_references(compiled);
|
||||
}
|
||||
|
||||
/* Compute an address to store at a relocation */
|
||||
void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
|
@ -377,7 +372,7 @@ void factor_vm::update_word_references(code_block *compiled)
|
|||
code->heap_free(compiled);
|
||||
else
|
||||
{
|
||||
iterate_relocations(compiled,factor::update_word_references_step);
|
||||
iterate_relocations(compiled,&factor_vm::update_word_references_step);
|
||||
flush_icache_for(compiled);
|
||||
}
|
||||
}
|
||||
|
@ -476,7 +471,7 @@ void factor_vm::relocate_code_block(code_block *compiled)
|
|||
{
|
||||
compiled->last_scan = data->nursery();
|
||||
compiled->needs_fixup = false;
|
||||
iterate_relocations(compiled,factor::relocate_code_block_step);
|
||||
iterate_relocations(compiled,&factor_vm::relocate_code_block_step);
|
||||
flush_icache_for(compiled);
|
||||
}
|
||||
|
||||
|
|
|
@ -62,14 +62,4 @@ static const cell rel_relative_arm_3_mask = 0xffffff;
|
|||
/* code relocation table consists of a table of entries for each fixup */
|
||||
typedef u32 relocation_entry;
|
||||
|
||||
struct factor_vm;
|
||||
|
||||
typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled, factor_vm *vm);
|
||||
|
||||
// callback functions
|
||||
void relocate_code_block(code_block *compiled, factor_vm *myvm);
|
||||
void copy_literal_references(code_block *compiled, factor_vm *myvm);
|
||||
void update_word_references(code_block *compiled, factor_vm *myvm);
|
||||
void update_literal_and_word_references(code_block *compiled, factor_vm *myvm);
|
||||
|
||||
}
|
||||
|
|
|
@ -36,7 +36,7 @@ void factor_vm::iterate_code_heap(code_heap_iterator iter)
|
|||
while(scan)
|
||||
{
|
||||
if(scan->status != B_FREE)
|
||||
iter((code_block *)scan,this);
|
||||
(this->*iter)((code_block *)scan);
|
||||
scan = code->next_block(scan);
|
||||
}
|
||||
}
|
||||
|
@ -45,17 +45,17 @@ void factor_vm::iterate_code_heap(code_heap_iterator iter)
|
|||
aging and nursery collections */
|
||||
void factor_vm::copy_code_heap_roots()
|
||||
{
|
||||
iterate_code_heap(factor::copy_literal_references);
|
||||
iterate_code_heap(&factor_vm::copy_literal_references);
|
||||
}
|
||||
|
||||
/* Update pointers to words referenced from all code blocks. Only after
|
||||
defining a new word. */
|
||||
void factor_vm::update_code_heap_words()
|
||||
{
|
||||
iterate_code_heap(factor::update_word_references);
|
||||
iterate_code_heap(&factor_vm::update_word_references);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_modify_code_heap()
|
||||
void factor_vm::primitive_modify_code_heap()
|
||||
{
|
||||
gc_root<array> alist(dpop(),this);
|
||||
|
||||
|
@ -106,10 +106,8 @@ inline void factor_vm::primitive_modify_code_heap()
|
|||
update_code_heap_words();
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(modify_code_heap)
|
||||
|
||||
/* Push the free space and total size of the code heap */
|
||||
inline void factor_vm::primitive_code_room()
|
||||
void factor_vm::primitive_code_room()
|
||||
{
|
||||
cell used, total_free, max_free;
|
||||
code->heap_usage(&used,&total_free,&max_free);
|
||||
|
@ -119,8 +117,6 @@ inline void factor_vm::primitive_code_room()
|
|||
dpush(tag_fixnum(max_free / 1024));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(code_room)
|
||||
|
||||
code_block *factor_vm::forward_xt(code_block *compiled)
|
||||
{
|
||||
return (code_block *)forwarding[compiled];
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
struct factor_vm;
|
||||
typedef void (*code_heap_iterator)(code_block *compiled, factor_vm *myvm);
|
||||
|
||||
PRIMITIVE(modify_code_heap);
|
||||
PRIMITIVE(code_room);
|
||||
inline void factor_vm::check_code_pointer(cell ptr)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(in_code_heap_p(ptr));
|
||||
#endif
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -140,22 +140,18 @@ bool factor_vm::stack_to_array(cell bottom, cell top)
|
|||
}
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_datastack()
|
||||
void factor_vm::primitive_datastack()
|
||||
{
|
||||
if(!stack_to_array(ds_bot,ds))
|
||||
general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(datastack)
|
||||
|
||||
inline void factor_vm::primitive_retainstack()
|
||||
void factor_vm::primitive_retainstack()
|
||||
{
|
||||
if(!stack_to_array(rs_bot,rs))
|
||||
general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(retainstack)
|
||||
|
||||
/* returns pointer to top of stack */
|
||||
cell factor_vm::array_to_stack(array *array, cell bottom)
|
||||
{
|
||||
|
@ -164,22 +160,18 @@ cell factor_vm::array_to_stack(array *array, cell bottom)
|
|||
return bottom + depth - sizeof(cell);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_set_datastack()
|
||||
void factor_vm::primitive_set_datastack()
|
||||
{
|
||||
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(set_datastack)
|
||||
|
||||
inline void factor_vm::primitive_set_retainstack()
|
||||
void factor_vm::primitive_set_retainstack()
|
||||
{
|
||||
rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(set_retainstack)
|
||||
|
||||
/* Used to implement call( */
|
||||
inline void factor_vm::primitive_check_datastack()
|
||||
void factor_vm::primitive_check_datastack()
|
||||
{
|
||||
fixnum out = to_fixnum(dpop());
|
||||
fixnum in = to_fixnum(dpop());
|
||||
|
@ -204,6 +196,4 @@ inline void factor_vm::primitive_check_datastack()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(check_datastack)
|
||||
|
||||
}
|
||||
|
|
|
@ -44,12 +44,6 @@ struct context {
|
|||
DEFPUSHPOP(d,ds)
|
||||
DEFPUSHPOP(r,rs)
|
||||
|
||||
PRIMITIVE(datastack);
|
||||
PRIMITIVE(retainstack);
|
||||
PRIMITIVE(set_datastack);
|
||||
PRIMITIVE(set_retainstack);
|
||||
PRIMITIVE(check_datastack);
|
||||
|
||||
struct factor_vm;
|
||||
VM_C_API void nest_stacks(factor_vm *vm);
|
||||
VM_C_API void unnest_stacks(factor_vm *vm);
|
||||
|
|
43
vm/cpu-ppc.S
43
vm/cpu-ppc.S
|
@ -4,40 +4,43 @@ in the public domain. */
|
|||
|
||||
#define DS_REG r13
|
||||
|
||||
DEF(void,primitive_fixnum_add,(void)):
|
||||
DEF(void,primitive_fixnum_add,(void *vm)):
|
||||
mr r5,r3 /* save vm ptr for overflow */
|
||||
lwz r3,0(DS_REG)
|
||||
lwz r4,-4(DS_REG)
|
||||
subi DS_REG,DS_REG,4
|
||||
li r0,0
|
||||
mtxer r0
|
||||
addo. r5,r3,r4
|
||||
addo. r6,r3,r4
|
||||
bso add_overflow
|
||||
stw r5,0(DS_REG)
|
||||
stw r6,0(DS_REG)
|
||||
blr
|
||||
add_overflow:
|
||||
b MANGLE(overflow_fixnum_add)
|
||||
|
||||
DEF(void,primitive_fixnum_subtract,(void)):
|
||||
DEF(void,primitive_fixnum_subtract,(void *vm)):
|
||||
mr r5,r3 /* save vm ptr for overflow */
|
||||
lwz r3,-4(DS_REG)
|
||||
lwz r4,0(DS_REG)
|
||||
subi DS_REG,DS_REG,4
|
||||
li r0,0
|
||||
mtxer r0
|
||||
subfo. r5,r4,r3
|
||||
subfo. r6,r4,r3
|
||||
bso sub_overflow
|
||||
stw r5,0(DS_REG)
|
||||
stw r6,0(DS_REG)
|
||||
blr
|
||||
sub_overflow:
|
||||
b MANGLE(overflow_fixnum_subtract)
|
||||
|
||||
DEF(void,primitive_fixnum_multiply,(void)):
|
||||
DEF(void,primitive_fixnum_multiply,(void *vm)):
|
||||
mr r5,r3 /* save vm ptr for overflow */
|
||||
lwz r3,0(DS_REG)
|
||||
lwz r4,-4(DS_REG)
|
||||
subi DS_REG,DS_REG,4
|
||||
srawi r3,r3,3
|
||||
mullwo. r5,r3,r4
|
||||
mullwo. r6,r3,r4
|
||||
bso multiply_overflow
|
||||
stw r5,0(DS_REG)
|
||||
stw r6,0(DS_REG)
|
||||
blr
|
||||
multiply_overflow:
|
||||
srawi r4,r4,3
|
||||
|
@ -107,7 +110,7 @@ multiply_overflow:
|
|||
|
||||
/* We have to save and restore nonvolatile registers because
|
||||
the Factor compiler treats the entire register file as volatile. */
|
||||
DEF(void,c_to_factor,(CELL quot)):
|
||||
DEF(void,c_to_factor,(CELL quot, void *vm)):
|
||||
PROLOGUE
|
||||
|
||||
SAVE_INT(r15,0) /* save GPRs */
|
||||
|
@ -160,14 +163,15 @@ DEF(void,c_to_factor,(CELL quot)):
|
|||
SAVE_V(v30,96)
|
||||
SAVE_V(v31,100)
|
||||
|
||||
/* r4 vm ptr preserved */
|
||||
mfvscr v0
|
||||
li r2,SAVE_AT(104)
|
||||
stvxl v0,r2,r1
|
||||
addi r2,r2,0xc
|
||||
lwzx r4,r2,r1
|
||||
lis r5,0x1
|
||||
andc r4,r4,r5
|
||||
stwx r4,r2,r1
|
||||
lwzx r5,r2,r1
|
||||
lis r6,0x1
|
||||
andc r5,r5,r6
|
||||
stwx r5,r2,r1
|
||||
subi r2,r2,0xc
|
||||
lvxl v0,r2,r1
|
||||
mtvscr v0
|
||||
|
@ -250,13 +254,15 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi
|
|||
mtlr r0 /* prepare to return to restored callstack */
|
||||
blr /* go */
|
||||
|
||||
DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
|
||||
DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
|
||||
mr r1,r4 /* compute new stack pointer */
|
||||
mr r4,r5 /* make vm ptr 2nd arg in case quot_xt = lazy_jit_compile */
|
||||
lwz r0,LR_SAVE(r1) /* we have rewound the stack; load return address */
|
||||
mtlr r0
|
||||
JUMP_QUOT /* call the quotation */
|
||||
|
||||
DEF(void,lazy_jit_compile,(CELL quot)):
|
||||
DEF(void,lazy_jit_compile,(CELL quot, void *vm)):
|
||||
mr r5,r4 /* vm ptr is 3rd arg */
|
||||
mr r4,r1 /* save stack pointer */
|
||||
PROLOGUE
|
||||
bl MANGLE(lazy_jit_compile_impl)
|
||||
|
@ -286,10 +292,11 @@ DEF(void,flush_icache,(void *start, int len)):
|
|||
isync
|
||||
blr
|
||||
|
||||
DEF(void,primitive_inline_cache_miss,(void)):
|
||||
DEF(void,primitive_inline_cache_miss,(void *vm)):
|
||||
mflr r6
|
||||
DEF(void,primitive_inline_cache_miss_tail,(void)):
|
||||
DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
|
||||
PROLOGUE
|
||||
mr r4,r3 /* vm ptr in 2nd arg */
|
||||
mr r3,r6
|
||||
bl MANGLE(inline_cache_miss)
|
||||
EPILOGUE
|
||||
|
|
|
@ -546,7 +546,7 @@ void factor_vm::garbage_collection(cell gen,bool growing_data_heap_,cell request
|
|||
code_heap_scans++;
|
||||
|
||||
if(collecting_gen == data->tenured())
|
||||
code->free_unmarked((heap_iterator)factor::update_literal_and_word_references);
|
||||
code->free_unmarked((heap_iterator)&factor_vm::update_literal_and_word_references);
|
||||
else
|
||||
copy_code_heap_roots();
|
||||
|
||||
|
@ -568,14 +568,12 @@ void factor_vm::gc()
|
|||
garbage_collection(data->tenured(),false,0);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_gc()
|
||||
void factor_vm::primitive_gc()
|
||||
{
|
||||
gc();
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(gc)
|
||||
|
||||
inline void factor_vm::primitive_gc_stats()
|
||||
void factor_vm::primitive_gc_stats()
|
||||
{
|
||||
growable_array result(this);
|
||||
|
||||
|
@ -605,8 +603,6 @@ inline void factor_vm::primitive_gc_stats()
|
|||
dpush(result.elements.value());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(gc_stats)
|
||||
|
||||
void factor_vm::clear_gc_stats()
|
||||
{
|
||||
for(cell i = 0; i < max_gen_count; i++)
|
||||
|
@ -618,16 +614,14 @@ void factor_vm::clear_gc_stats()
|
|||
code_heap_scans = 0;
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_clear_gc_stats()
|
||||
void factor_vm::primitive_clear_gc_stats()
|
||||
{
|
||||
clear_gc_stats();
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(clear_gc_stats)
|
||||
|
||||
/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
|
||||
to coalesce equal but distinct quotations and wrappers. */
|
||||
inline void factor_vm::primitive_become()
|
||||
void factor_vm::primitive_become()
|
||||
{
|
||||
array *new_objects = untag_check<array>(dpop());
|
||||
array *old_objects = untag_check<array>(dpop());
|
||||
|
@ -656,8 +650,6 @@ inline void factor_vm::primitive_become()
|
|||
compile_all_words();
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(become)
|
||||
|
||||
void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
|
||||
{
|
||||
for(cell i = 0; i < gc_roots_size; i++)
|
||||
|
@ -675,4 +667,68 @@ VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm
|
|||
VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
|
||||
}
|
||||
|
||||
inline object *factor_vm::allot_zone(zone *z, cell a)
|
||||
{
|
||||
cell h = z->here;
|
||||
z->here = h + align8(a);
|
||||
object *obj = (object *)h;
|
||||
allot_barrier(obj);
|
||||
return obj;
|
||||
}
|
||||
|
||||
/*
|
||||
* It is up to the caller to fill in the object's fields in a meaningful
|
||||
* fashion!
|
||||
*/
|
||||
object *factor_vm::allot_object(header header, cell size)
|
||||
{
|
||||
#ifdef GC_DEBUG
|
||||
if(!gc_off)
|
||||
gc();
|
||||
#endif
|
||||
|
||||
object *obj;
|
||||
|
||||
if(nursery.size - allot_buffer_zone > size)
|
||||
{
|
||||
/* If there is insufficient room, collect the nursery */
|
||||
if(nursery.here + allot_buffer_zone + size > nursery.end)
|
||||
garbage_collection(data->nursery(),false,0);
|
||||
|
||||
cell h = nursery.here;
|
||||
nursery.here = h + align8(size);
|
||||
obj = (object *)h;
|
||||
}
|
||||
/* If the object is bigger than the nursery, allocate it in
|
||||
tenured space */
|
||||
else
|
||||
{
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
/* If tenured space does not have enough room, collect */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
gc();
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
/* If it still won't fit, grow the heap */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
garbage_collection(data->tenured(),true,size);
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
obj = allot_zone(tenured,size);
|
||||
|
||||
/* Allows initialization code to store old->new pointers
|
||||
without hitting the write barrier in the common case of
|
||||
a nursery allocation */
|
||||
write_barrier(obj);
|
||||
}
|
||||
|
||||
obj->h = header;
|
||||
return obj;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -15,10 +15,6 @@ allocation (which does not call GC because of possible roots in volatile
|
|||
registers) does not run out of memory */
|
||||
static const cell allot_buffer_zone = 1024;
|
||||
|
||||
PRIMITIVE(gc);
|
||||
PRIMITIVE(gc_stats);
|
||||
PRIMITIVE(clear_gc_stats);
|
||||
PRIMITIVE(become);
|
||||
struct factor_vm;
|
||||
VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
|
||||
|
||||
|
|
|
@ -206,13 +206,11 @@ cell factor_vm::unaligned_object_size(object *pointer)
|
|||
}
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_size()
|
||||
void factor_vm::primitive_size()
|
||||
{
|
||||
box_unsigned_cell(object_size(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(size)
|
||||
|
||||
/* The number of cells from the start of the object which should be scanned by
|
||||
the GC. Some types have a binary payload at the end (string, word, DLL) which
|
||||
we ignore. */
|
||||
|
@ -251,7 +249,7 @@ cell factor_vm::binary_payload_start(object *pointer)
|
|||
}
|
||||
|
||||
/* Push memory usage statistics in data heap */
|
||||
inline void factor_vm::primitive_data_room()
|
||||
void factor_vm::primitive_data_room()
|
||||
{
|
||||
dpush(tag_fixnum((data->cards_end - data->cards) >> 10));
|
||||
dpush(tag_fixnum((data->decks_end - data->decks) >> 10));
|
||||
|
@ -270,8 +268,6 @@ inline void factor_vm::primitive_data_room()
|
|||
dpush(a.elements.value());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(data_room)
|
||||
|
||||
/* Disables GC and activates next-object ( -- obj ) primitive */
|
||||
void factor_vm::begin_scan()
|
||||
{
|
||||
|
@ -284,13 +280,11 @@ void factor_vm::end_scan()
|
|||
gc_off = false;
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_begin_scan()
|
||||
void factor_vm::primitive_begin_scan()
|
||||
{
|
||||
begin_scan();
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(begin_scan)
|
||||
|
||||
cell factor_vm::next_object()
|
||||
{
|
||||
if(!gc_off)
|
||||
|
@ -305,21 +299,17 @@ cell factor_vm::next_object()
|
|||
}
|
||||
|
||||
/* Push object at heap scan cursor and advance; pushes f when done */
|
||||
inline void factor_vm::primitive_next_object()
|
||||
void factor_vm::primitive_next_object()
|
||||
{
|
||||
dpush(next_object());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(next_object)
|
||||
|
||||
/* Re-enables GC */
|
||||
inline void factor_vm::primitive_end_scan()
|
||||
void factor_vm::primitive_end_scan()
|
||||
{
|
||||
gc_off = false;
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(end_scan)
|
||||
|
||||
template<typename TYPE> void factor_vm::each_object(TYPE &functor)
|
||||
{
|
||||
begin_scan();
|
||||
|
|
|
@ -62,11 +62,4 @@ inline static bool in_zone(zone *z, object *pointer)
|
|||
return (cell)pointer >= z->start && (cell)pointer < z->end;
|
||||
}
|
||||
|
||||
PRIMITIVE(data_room);
|
||||
PRIMITIVE(size);
|
||||
|
||||
PRIMITIVE(begin_scan);
|
||||
PRIMITIVE(next_object);
|
||||
PRIMITIVE(end_scan);
|
||||
|
||||
}
|
||||
|
|
|
@ -263,7 +263,6 @@ void factor_vm::dump_objects(cell type)
|
|||
end_scan();
|
||||
}
|
||||
|
||||
|
||||
void factor_vm::find_data_references_step(cell *scan)
|
||||
{
|
||||
if(look_for == *scan)
|
||||
|
@ -477,13 +476,11 @@ void factor_vm::factorbug()
|
|||
}
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_die()
|
||||
void factor_vm::primitive_die()
|
||||
{
|
||||
print_string("The die word was called by the library. Unless you called it yourself,\n");
|
||||
print_string("you have triggered a bug in Factor. Please report.\n");
|
||||
factorbug();
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(die)
|
||||
|
||||
}
|
||||
|
|
|
@ -1,6 +1,4 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE(die);
|
||||
|
||||
}
|
||||
|
|
|
@ -113,15 +113,13 @@ cell factor_vm::lookup_method(cell obj, cell methods)
|
|||
return array_nth(untag<array>(methods),TAG(obj));
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_lookup_method()
|
||||
void factor_vm::primitive_lookup_method()
|
||||
{
|
||||
cell methods = dpop();
|
||||
cell obj = dpop();
|
||||
dpush(lookup_method(obj,methods));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(lookup_method)
|
||||
|
||||
cell factor_vm::object_class(cell obj)
|
||||
{
|
||||
switch(TAG(obj))
|
||||
|
@ -149,7 +147,7 @@ void factor_vm::update_method_cache(cell cache, cell klass, cell method)
|
|||
set_array_nth(cache_elements,hashcode + 1,method);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_mega_cache_miss()
|
||||
void factor_vm::primitive_mega_cache_miss()
|
||||
{
|
||||
megamorphic_cache_misses++;
|
||||
|
||||
|
@ -166,16 +164,12 @@ inline void factor_vm::primitive_mega_cache_miss()
|
|||
dpush(method);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(mega_cache_miss)
|
||||
|
||||
inline void factor_vm::primitive_reset_dispatch_stats()
|
||||
void factor_vm::primitive_reset_dispatch_stats()
|
||||
{
|
||||
megamorphic_cache_hits = megamorphic_cache_misses = 0;
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(reset_dispatch_stats)
|
||||
|
||||
inline void factor_vm::primitive_dispatch_stats()
|
||||
void factor_vm::primitive_dispatch_stats()
|
||||
{
|
||||
growable_array stats(this);
|
||||
stats.add(allot_cell(megamorphic_cache_hits));
|
||||
|
@ -184,8 +178,6 @@ inline void factor_vm::primitive_dispatch_stats()
|
|||
dpush(stats.elements.value());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(dispatch_stats)
|
||||
|
||||
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)
|
||||
{
|
||||
gc_root<array> methods(methods_,parent_vm);
|
||||
|
|
|
@ -1,9 +1,4 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE(lookup_method);
|
||||
PRIMITIVE(mega_cache_miss);
|
||||
PRIMITIVE(reset_dispatch_stats);
|
||||
PRIMITIVE(dispatch_stats);
|
||||
|
||||
}
|
||||
|
|
|
@ -128,21 +128,17 @@ void factor_vm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_calls
|
|||
general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),F,signal_callstack_top);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_call_clear()
|
||||
void factor_vm::primitive_call_clear()
|
||||
{
|
||||
throw_impl(dpop(),stack_chain->callstack_bottom,this);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(call_clear)
|
||||
|
||||
/* For testing purposes */
|
||||
inline void factor_vm::primitive_unimplemented()
|
||||
void factor_vm::primitive_unimplemented()
|
||||
{
|
||||
not_implemented_error();
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(unimplemented)
|
||||
|
||||
void factor_vm::memory_signal_handler_impl()
|
||||
{
|
||||
memory_protection_error(signal_fault_addr,signal_callstack_top);
|
||||
|
|
|
@ -23,10 +23,6 @@ enum vm_error_type
|
|||
ERROR_FP_TRAP,
|
||||
};
|
||||
|
||||
PRIMITIVE(die);
|
||||
PRIMITIVE(call_clear);
|
||||
PRIMITIVE(unimplemented);
|
||||
|
||||
void fatal_error(const char* msg, cell tagged);
|
||||
void memory_signal_handler_impl();
|
||||
void fp_signal_handler_impl();
|
||||
|
|
|
@ -19,4 +19,41 @@ template <typename T> cell array_size(T *array)
|
|||
return array_size<T>(array_capacity(array));
|
||||
}
|
||||
|
||||
template <typename TYPE> TYPE *factor_vm::allot_array_internal(cell capacity)
|
||||
{
|
||||
TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
template <typename TYPE> bool factor_vm::reallot_array_in_place_p(TYPE *array, cell capacity)
|
||||
{
|
||||
return in_zone(&nursery,array) && capacity <= array_capacity(array);
|
||||
}
|
||||
|
||||
template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capacity)
|
||||
{
|
||||
gc_root<TYPE> array(array_,this);
|
||||
|
||||
if(reallot_array_in_place_p(array.untagged(),capacity))
|
||||
{
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array.untagged();
|
||||
}
|
||||
else
|
||||
{
|
||||
cell to_copy = array_capacity(array.untagged());
|
||||
if(capacity < to_copy)
|
||||
to_copy = capacity;
|
||||
|
||||
TYPE *new_array = allot_array_internal<TYPE>(capacity);
|
||||
|
||||
memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
|
||||
memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
|
||||
0,(capacity - to_copy) * TYPE::element_size);
|
||||
|
||||
return new_array;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -244,7 +244,7 @@ void heap::free_unmarked(heap_iterator iter)
|
|||
add_to_free_list((free_heap_block *)prev);
|
||||
scan->status = B_ALLOCATED;
|
||||
prev = scan;
|
||||
iter(scan,myvm);
|
||||
(myvm->*iter)(scan);
|
||||
break;
|
||||
default:
|
||||
myvm->critical_error("Invalid scan->status",(cell)scan);
|
||||
|
|
|
@ -9,7 +9,7 @@ struct heap_free_list {
|
|||
free_heap_block *large_blocks;
|
||||
};
|
||||
|
||||
typedef void (*heap_iterator)(heap_block *compiled, factor_vm *vm);
|
||||
typedef void (factor_vm::*heap_iterator)(heap_block *compiled);
|
||||
|
||||
struct heap {
|
||||
factor_vm *myvm;
|
||||
|
|
10
vm/image.cpp
10
vm/image.cpp
|
@ -118,7 +118,7 @@ bool factor_vm::save_image(const vm_char *filename)
|
|||
return ok;
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_save_image()
|
||||
void factor_vm::primitive_save_image()
|
||||
{
|
||||
/* do a full GC to push everything into tenured space */
|
||||
gc();
|
||||
|
@ -128,9 +128,7 @@ inline void factor_vm::primitive_save_image()
|
|||
save_image((vm_char *)(path.untagged() + 1));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(save_image)
|
||||
|
||||
inline void factor_vm::primitive_save_image_and_exit()
|
||||
void factor_vm::primitive_save_image_and_exit()
|
||||
{
|
||||
/* We unbox this before doing anything else. This is the only point
|
||||
where we might throw an error, so we have to throw an error here since
|
||||
|
@ -156,8 +154,6 @@ inline void factor_vm::primitive_save_image_and_exit()
|
|||
exit(1);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(save_image_and_exit)
|
||||
|
||||
void factor_vm::data_fixup(cell *cell)
|
||||
{
|
||||
if(immediate_p(*cell))
|
||||
|
@ -307,7 +303,7 @@ void fixup_code_block(code_block *compiled, factor_vm *myvm)
|
|||
|
||||
void factor_vm::relocate_code()
|
||||
{
|
||||
iterate_code_heap(factor::fixup_code_block);
|
||||
iterate_code_heap(&factor_vm::fixup_code_block);
|
||||
}
|
||||
|
||||
/* Read an image file from disk, only done once during startup */
|
||||
|
|
|
@ -41,7 +41,4 @@ struct vm_parameters {
|
|||
cell max_pic_size;
|
||||
};
|
||||
|
||||
PRIMITIVE(save_image);
|
||||
PRIMITIVE(save_image_and_exit);
|
||||
|
||||
}
|
||||
|
|
|
@ -250,16 +250,14 @@ VM_C_API void *inline_cache_miss(cell return_address, factor_vm *myvm)
|
|||
return VM_PTR->inline_cache_miss(return_address);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_reset_inline_cache_stats()
|
||||
void factor_vm::primitive_reset_inline_cache_stats()
|
||||
{
|
||||
cold_call_to_ic_transitions = ic_to_pic_transitions = pic_to_mega_transitions = 0;
|
||||
cell i;
|
||||
for(i = 0; i < 4; i++) pic_counts[i] = 0;
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(reset_inline_cache_stats)
|
||||
|
||||
inline void factor_vm::primitive_inline_cache_stats()
|
||||
void factor_vm::primitive_inline_cache_stats()
|
||||
{
|
||||
growable_array stats(this);
|
||||
stats.add(allot_cell(cold_call_to_ic_transitions));
|
||||
|
@ -272,6 +270,4 @@ inline void factor_vm::primitive_inline_cache_stats()
|
|||
dpush(stats.elements.value());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(inline_cache_stats)
|
||||
|
||||
}
|
||||
|
|
|
@ -1,9 +1,5 @@
|
|||
namespace factor
|
||||
{
|
||||
PRIMITIVE(reset_inline_cache_stats);
|
||||
PRIMITIVE(inline_cache_stats);
|
||||
PRIMITIVE(inline_cache_miss);
|
||||
PRIMITIVE(inline_cache_miss_tail);
|
||||
|
||||
VM_C_API void *inline_cache_miss(cell return_address, factor_vm *vm);
|
||||
|
||||
|
|
|
@ -1,394 +0,0 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
// I've had to copy inline implementations here to make dependencies work. Am hoping to move this code back into include files
|
||||
// once the rest of the reentrant changes are done. -PD
|
||||
|
||||
// write_barrier.hpp
|
||||
|
||||
inline card *factor_vm::addr_to_card(cell a)
|
||||
{
|
||||
return (card*)(((cell)(a) >> card_bits) + cards_offset);
|
||||
}
|
||||
|
||||
inline cell factor_vm::card_to_addr(card *c)
|
||||
{
|
||||
return ((cell)c - cards_offset) << card_bits;
|
||||
}
|
||||
|
||||
inline cell factor_vm::card_offset(card *c)
|
||||
{
|
||||
return *(c - (cell)data->cards + (cell)data->allot_markers);
|
||||
}
|
||||
|
||||
inline card_deck *factor_vm::addr_to_deck(cell a)
|
||||
{
|
||||
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
|
||||
}
|
||||
|
||||
inline cell factor_vm::deck_to_addr(card_deck *c)
|
||||
{
|
||||
return ((cell)c - decks_offset) << deck_bits;
|
||||
}
|
||||
|
||||
inline card *factor_vm::deck_to_card(card_deck *d)
|
||||
{
|
||||
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
|
||||
}
|
||||
|
||||
inline card *factor_vm::addr_to_allot_marker(object *a)
|
||||
{
|
||||
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
|
||||
}
|
||||
|
||||
/* the write barrier must be called any time we are potentially storing a
|
||||
pointer from an older generation to a younger one */
|
||||
inline void factor_vm::write_barrier(object *obj)
|
||||
{
|
||||
*addr_to_card((cell)obj) = card_mark_mask;
|
||||
*addr_to_deck((cell)obj) = card_mark_mask;
|
||||
}
|
||||
|
||||
/* we need to remember the first object allocated in the card */
|
||||
inline void factor_vm::allot_barrier(object *address)
|
||||
{
|
||||
card *ptr = addr_to_allot_marker(address);
|
||||
if(*ptr == invalid_allot_marker)
|
||||
*ptr = ((cell)address & addr_card_mask);
|
||||
}
|
||||
|
||||
//data_gc.hpp
|
||||
inline bool factor_vm::collecting_accumulation_gen_p()
|
||||
{
|
||||
return ((data->have_aging_p()
|
||||
&& collecting_gen == data->aging()
|
||||
&& !collecting_aging_again)
|
||||
|| collecting_gen == data->tenured());
|
||||
}
|
||||
|
||||
inline object *factor_vm::allot_zone(zone *z, cell a)
|
||||
{
|
||||
cell h = z->here;
|
||||
z->here = h + align8(a);
|
||||
object *obj = (object *)h;
|
||||
allot_barrier(obj);
|
||||
return obj;
|
||||
}
|
||||
|
||||
/*
|
||||
* It is up to the caller to fill in the object's fields in a meaningful
|
||||
* fashion!
|
||||
*/
|
||||
inline object *factor_vm::allot_object(header header, cell size)
|
||||
{
|
||||
#ifdef GC_DEBUG
|
||||
if(!gc_off)
|
||||
gc();
|
||||
#endif
|
||||
|
||||
object *obj;
|
||||
|
||||
if(nursery.size - allot_buffer_zone > size)
|
||||
{
|
||||
/* If there is insufficient room, collect the nursery */
|
||||
if(nursery.here + allot_buffer_zone + size > nursery.end)
|
||||
garbage_collection(data->nursery(),false,0);
|
||||
|
||||
cell h = nursery.here;
|
||||
nursery.here = h + align8(size);
|
||||
obj = (object *)h;
|
||||
}
|
||||
/* If the object is bigger than the nursery, allocate it in
|
||||
tenured space */
|
||||
else
|
||||
{
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
/* If tenured space does not have enough room, collect */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
gc();
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
/* If it still won't fit, grow the heap */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
garbage_collection(data->tenured(),true,size);
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
obj = allot_zone(tenured,size);
|
||||
|
||||
/* Allows initialization code to store old->new pointers
|
||||
without hitting the write barrier in the common case of
|
||||
a nursery allocation */
|
||||
write_barrier(obj);
|
||||
}
|
||||
|
||||
obj->h = header;
|
||||
return obj;
|
||||
}
|
||||
|
||||
template<typename TYPE> TYPE *factor_vm::allot(cell size)
|
||||
{
|
||||
return (TYPE *)allot_object(header(TYPE::type_number),size);
|
||||
}
|
||||
|
||||
inline void factor_vm::check_data_pointer(object *pointer)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!growing_data_heap)
|
||||
{
|
||||
assert((cell)pointer >= data->seg->start
|
||||
&& (cell)pointer < data->seg->end);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
inline void factor_vm::check_tagged_pointer(cell tagged)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!immediate_p(tagged))
|
||||
{
|
||||
object *obj = untag<object>(tagged);
|
||||
check_data_pointer(obj);
|
||||
obj->h.hi_tag();
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
//local_roots.hpp
|
||||
template <typename TYPE>
|
||||
struct gc_root : public tagged<TYPE>
|
||||
{
|
||||
factor_vm *parent_vm;
|
||||
|
||||
void push() { parent_vm->check_tagged_pointer(tagged<TYPE>::value()); parent_vm->gc_locals.push_back((cell)this); }
|
||||
|
||||
explicit gc_root(cell value_,factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); }
|
||||
explicit gc_root(TYPE *value_, factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); }
|
||||
|
||||
const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
|
||||
const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
|
||||
|
||||
~gc_root() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(myvm->gc_locals.back() == (cell)this);
|
||||
#endif
|
||||
parent_vm->gc_locals.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
/* A similar hack for the bignum implementation */
|
||||
struct gc_bignum
|
||||
{
|
||||
bignum **addr;
|
||||
factor_vm *parent_vm;
|
||||
gc_bignum(bignum **addr_, factor_vm *vm) : addr(addr_), parent_vm(vm) {
|
||||
if(*addr_)
|
||||
parent_vm->check_data_pointer(*addr_);
|
||||
parent_vm->gc_bignums.push_back((cell)addr);
|
||||
}
|
||||
|
||||
~gc_bignum() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(myvm->gc_bignums.back() == (cell)addr);
|
||||
#endif
|
||||
parent_vm->gc_bignums.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
#define GC_BIGNUM(x) gc_bignum x##__gc_root(&x,this)
|
||||
|
||||
//generic_arrays.hpp
|
||||
template <typename TYPE> TYPE *factor_vm::allot_array_internal(cell capacity)
|
||||
{
|
||||
TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
template <typename TYPE> bool factor_vm::reallot_array_in_place_p(TYPE *array, cell capacity)
|
||||
{
|
||||
return in_zone(&nursery,array) && capacity <= array_capacity(array);
|
||||
}
|
||||
|
||||
template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capacity)
|
||||
{
|
||||
gc_root<TYPE> array(array_,this);
|
||||
|
||||
if(reallot_array_in_place_p(array.untagged(),capacity))
|
||||
{
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array.untagged();
|
||||
}
|
||||
else
|
||||
{
|
||||
cell to_copy = array_capacity(array.untagged());
|
||||
if(capacity < to_copy)
|
||||
to_copy = capacity;
|
||||
|
||||
TYPE *new_array = allot_array_internal<TYPE>(capacity);
|
||||
|
||||
memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
|
||||
memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
|
||||
0,(capacity - to_copy) * TYPE::element_size);
|
||||
|
||||
return new_array;
|
||||
}
|
||||
}
|
||||
|
||||
//arrays.hpp
|
||||
inline void factor_vm::set_array_nth(array *array, cell slot, cell value)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(slot < array_capacity(array));
|
||||
assert(array->h.hi_tag() == ARRAY_TYPE);
|
||||
check_tagged_pointer(value);
|
||||
#endif
|
||||
array->data()[slot] = value;
|
||||
write_barrier(array);
|
||||
}
|
||||
|
||||
struct growable_array {
|
||||
cell count;
|
||||
gc_root<array> elements;
|
||||
|
||||
growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
|
||||
|
||||
void add(cell elt);
|
||||
void trim();
|
||||
};
|
||||
|
||||
//byte_arrays.hpp
|
||||
struct growable_byte_array {
|
||||
cell count;
|
||||
gc_root<byte_array> elements;
|
||||
|
||||
growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
|
||||
|
||||
void append_bytes(void *elts, cell len);
|
||||
void append_byte_array(cell elts);
|
||||
|
||||
void trim();
|
||||
};
|
||||
|
||||
//math.hpp
|
||||
inline cell factor_vm::allot_integer(fixnum x)
|
||||
{
|
||||
if(x < fixnum_min || x > fixnum_max)
|
||||
return tag<bignum>(fixnum_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
inline cell factor_vm::allot_cell(cell x)
|
||||
{
|
||||
if(x > (cell)fixnum_max)
|
||||
return tag<bignum>(cell_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
inline cell factor_vm::allot_float(double n)
|
||||
{
|
||||
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
|
||||
flo->n = n;
|
||||
return tag(flo);
|
||||
}
|
||||
|
||||
inline bignum *factor_vm::float_to_bignum(cell tagged)
|
||||
{
|
||||
return double_to_bignum(untag_float(tagged));
|
||||
}
|
||||
|
||||
inline double factor_vm::bignum_to_float(cell tagged)
|
||||
{
|
||||
return bignum_to_double(untag<bignum>(tagged));
|
||||
}
|
||||
|
||||
inline double factor_vm::untag_float(cell tagged)
|
||||
{
|
||||
return untag<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline double factor_vm::untag_float_check(cell tagged)
|
||||
{
|
||||
return untag_check<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline fixnum factor_vm::float_to_fixnum(cell tagged)
|
||||
{
|
||||
return (fixnum)untag_float(tagged);
|
||||
}
|
||||
|
||||
inline double factor_vm::fixnum_to_float(cell tagged)
|
||||
{
|
||||
return (double)untag_fixnum(tagged);
|
||||
}
|
||||
|
||||
//callstack.hpp
|
||||
/* This is a little tricky. The iterator may allocate memory, so we
|
||||
keep the callstack in a GC root and use relative offsets */
|
||||
template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
|
||||
{
|
||||
gc_root<callstack> stack(stack_,this);
|
||||
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
|
||||
|
||||
while(frame_offset >= 0)
|
||||
{
|
||||
stack_frame *frame = stack->frame_at(frame_offset);
|
||||
frame_offset -= frame->size;
|
||||
iterator(frame,this);
|
||||
}
|
||||
}
|
||||
|
||||
//booleans.hpp
|
||||
inline cell factor_vm::tag_boolean(cell untagged)
|
||||
{
|
||||
return (untagged ? T : F);
|
||||
}
|
||||
|
||||
// callstack.hpp
|
||||
template<typename TYPE> void factor_vm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
|
||||
{
|
||||
stack_frame *frame = (stack_frame *)bottom - 1;
|
||||
|
||||
while((cell)frame >= top)
|
||||
{
|
||||
iterator(frame,this);
|
||||
frame = frame_successor(frame);
|
||||
}
|
||||
}
|
||||
|
||||
// data_heap.hpp
|
||||
/* Every object has a regular representation in the runtime, which makes GC
|
||||
much simpler. Every slot of the object until binary_payload_start is a pointer
|
||||
to some other object. */
|
||||
struct factor_vm;
|
||||
inline void factor_vm::do_slots(cell obj, void (* iter)(cell *,factor_vm*))
|
||||
{
|
||||
cell scan = obj;
|
||||
cell payload_start = binary_payload_start((object *)obj);
|
||||
cell end = obj + payload_start;
|
||||
|
||||
scan += sizeof(cell);
|
||||
|
||||
while(scan < end)
|
||||
{
|
||||
iter((cell *)scan,this);
|
||||
scan += sizeof(cell);
|
||||
}
|
||||
}
|
||||
|
||||
// code_heap.hpp
|
||||
|
||||
inline void factor_vm::check_code_pointer(cell ptr)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(in_code_heap_p(ptr));
|
||||
#endif
|
||||
}
|
||||
|
||||
}
|
32
vm/io.cpp
32
vm/io.cpp
|
@ -31,7 +31,7 @@ void factor_vm::io_error()
|
|||
general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_fopen()
|
||||
void factor_vm::primitive_fopen()
|
||||
{
|
||||
gc_root<byte_array> mode(dpop(),this);
|
||||
gc_root<byte_array> path(dpop(),this);
|
||||
|
@ -52,9 +52,7 @@ inline void factor_vm::primitive_fopen()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fopen)
|
||||
|
||||
inline void factor_vm::primitive_fgetc()
|
||||
void factor_vm::primitive_fgetc()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
|
||||
|
@ -79,9 +77,7 @@ inline void factor_vm::primitive_fgetc()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fgetc)
|
||||
|
||||
inline void factor_vm::primitive_fread()
|
||||
void factor_vm::primitive_fread()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
fixnum size = unbox_array_size();
|
||||
|
@ -121,9 +117,7 @@ inline void factor_vm::primitive_fread()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fread)
|
||||
|
||||
inline void factor_vm::primitive_fputc()
|
||||
void factor_vm::primitive_fputc()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
fixnum ch = to_fixnum(dpop());
|
||||
|
@ -141,9 +135,7 @@ inline void factor_vm::primitive_fputc()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fputc)
|
||||
|
||||
inline void factor_vm::primitive_fwrite()
|
||||
void factor_vm::primitive_fwrite()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
byte_array *text = untag_check<byte_array>(dpop());
|
||||
|
@ -172,9 +164,7 @@ inline void factor_vm::primitive_fwrite()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fwrite)
|
||||
|
||||
inline void factor_vm::primitive_fseek()
|
||||
void factor_vm::primitive_fseek()
|
||||
{
|
||||
int whence = to_fixnum(dpop());
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
|
@ -199,9 +189,7 @@ inline void factor_vm::primitive_fseek()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fseek)
|
||||
|
||||
inline void factor_vm::primitive_fflush()
|
||||
void factor_vm::primitive_fflush()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
for(;;)
|
||||
|
@ -213,9 +201,7 @@ inline void factor_vm::primitive_fflush()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fflush)
|
||||
|
||||
inline void factor_vm::primitive_fclose()
|
||||
void factor_vm::primitive_fclose()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
for(;;)
|
||||
|
@ -227,8 +213,6 @@ inline void factor_vm::primitive_fclose()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fclose)
|
||||
|
||||
/* This function is used by FFI I/O. Accessing the errno global directly is
|
||||
not portable, since on some libc's errno is not a global but a funky macro that
|
||||
reads thread-local storage. */
|
||||
|
|
12
vm/io.hpp
12
vm/io.hpp
|
@ -1,19 +1,7 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE(fopen);
|
||||
PRIMITIVE(fgetc);
|
||||
PRIMITIVE(fread);
|
||||
PRIMITIVE(fputc);
|
||||
PRIMITIVE(fwrite);
|
||||
PRIMITIVE(fflush);
|
||||
PRIMITIVE(fseek);
|
||||
PRIMITIVE(fclose);
|
||||
|
||||
/* Platform specific primitives */
|
||||
PRIMITIVE(open_file);
|
||||
PRIMITIVE(existsp);
|
||||
PRIMITIVE(read_dir);
|
||||
|
||||
VM_C_API int err_no();
|
||||
VM_C_API void clear_err_no();
|
||||
|
|
|
@ -1,3 +1,46 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
template <typename TYPE>
|
||||
struct gc_root : public tagged<TYPE>
|
||||
{
|
||||
factor_vm *parent_vm;
|
||||
|
||||
void push() { parent_vm->check_tagged_pointer(tagged<TYPE>::value()); parent_vm->gc_locals.push_back((cell)this); }
|
||||
|
||||
explicit gc_root(cell value_,factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); }
|
||||
explicit gc_root(TYPE *value_, factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); }
|
||||
|
||||
const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
|
||||
const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
|
||||
|
||||
~gc_root() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(myvm->gc_locals.back() == (cell)this);
|
||||
#endif
|
||||
parent_vm->gc_locals.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
/* A similar hack for the bignum implementation */
|
||||
struct gc_bignum
|
||||
{
|
||||
bignum **addr;
|
||||
factor_vm *parent_vm;
|
||||
gc_bignum(bignum **addr_, factor_vm *vm) : addr(addr_), parent_vm(vm) {
|
||||
if(*addr_)
|
||||
parent_vm->check_data_pointer(*addr_);
|
||||
parent_vm->gc_bignums.push_back((cell)addr);
|
||||
}
|
||||
|
||||
~gc_bignum() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(myvm->gc_bignums.back() == (cell)addr);
|
||||
#endif
|
||||
parent_vm->gc_bignums.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
#define GC_BIGNUM(x) gc_bignum x##__gc_root(&x,this)
|
||||
|
||||
}
|
||||
|
|
|
@ -52,26 +52,25 @@
|
|||
#include "data_heap.hpp"
|
||||
#include "write_barrier.hpp"
|
||||
#include "data_gc.hpp"
|
||||
#include "local_roots.hpp"
|
||||
#include "generic_arrays.hpp"
|
||||
#include "debug.hpp"
|
||||
#include "arrays.hpp"
|
||||
#include "strings.hpp"
|
||||
#include "booleans.hpp"
|
||||
#include "byte_arrays.hpp"
|
||||
#include "tuples.hpp"
|
||||
#include "words.hpp"
|
||||
#include "math.hpp"
|
||||
#include "float_bits.hpp"
|
||||
#include "io.hpp"
|
||||
#include "heap.hpp"
|
||||
#include "code_heap.hpp"
|
||||
#include "image.hpp"
|
||||
#include "callstack.hpp"
|
||||
#include "alien.hpp"
|
||||
#include "vm.hpp"
|
||||
#include "tagged.hpp"
|
||||
#include "inlineimpls.hpp"
|
||||
#include "local_roots.hpp"
|
||||
#include "callstack.hpp"
|
||||
#include "generic_arrays.hpp"
|
||||
#include "arrays.hpp"
|
||||
#include "math.hpp"
|
||||
#include "booleans.hpp"
|
||||
#include "code_heap.hpp"
|
||||
#include "byte_arrays.hpp"
|
||||
#include "jit.hpp"
|
||||
#include "quotations.hpp"
|
||||
#include "dispatch.hpp"
|
||||
|
|
176
vm/math.cpp
176
vm/math.cpp
|
@ -3,23 +3,19 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
inline void factor_vm::primitive_bignum_to_fixnum()
|
||||
void factor_vm::primitive_bignum_to_fixnum()
|
||||
{
|
||||
drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_to_fixnum)
|
||||
|
||||
inline void factor_vm::primitive_float_to_fixnum()
|
||||
void factor_vm::primitive_float_to_fixnum()
|
||||
{
|
||||
drepl(tag_fixnum(float_to_fixnum(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_to_fixnum)
|
||||
|
||||
/* Division can only overflow when we are dividing the most negative fixnum
|
||||
by -1. */
|
||||
inline void factor_vm::primitive_fixnum_divint()
|
||||
void factor_vm::primitive_fixnum_divint()
|
||||
{
|
||||
fixnum y = untag_fixnum(dpop()); \
|
||||
fixnum x = untag_fixnum(dpeek());
|
||||
|
@ -30,9 +26,7 @@ inline void factor_vm::primitive_fixnum_divint()
|
|||
drepl(tag_fixnum(result));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fixnum_divint)
|
||||
|
||||
inline void factor_vm::primitive_fixnum_divmod()
|
||||
void factor_vm::primitive_fixnum_divmod()
|
||||
{
|
||||
cell y = ((cell *)ds)[0];
|
||||
cell x = ((cell *)ds)[-1];
|
||||
|
@ -48,8 +42,6 @@ inline void factor_vm::primitive_fixnum_divmod()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fixnum_divmod)
|
||||
|
||||
/*
|
||||
* If we're shifting right by n bits, we won't overflow as long as none of the
|
||||
* high WORD_SIZE-TAG_BITS-n bits are set.
|
||||
|
@ -69,7 +61,7 @@ inline fixnum factor_vm::branchless_abs(fixnum x)
|
|||
return (x ^ sign_mask(x)) - sign_mask(x);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_fixnum_shift()
|
||||
void factor_vm::primitive_fixnum_shift()
|
||||
{
|
||||
fixnum y = untag_fixnum(dpop());
|
||||
fixnum x = untag_fixnum(dpeek());
|
||||
|
@ -96,67 +88,51 @@ inline void factor_vm::primitive_fixnum_shift()
|
|||
fixnum_to_bignum(x),y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fixnum_shift)
|
||||
|
||||
inline void factor_vm::primitive_fixnum_to_bignum()
|
||||
void factor_vm::primitive_fixnum_to_bignum()
|
||||
{
|
||||
drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fixnum_to_bignum)
|
||||
|
||||
inline void factor_vm::primitive_float_to_bignum()
|
||||
void factor_vm::primitive_float_to_bignum()
|
||||
{
|
||||
drepl(tag<bignum>(float_to_bignum(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_to_bignum)
|
||||
|
||||
#define POP_BIGNUMS(x,y) \
|
||||
bignum * y = untag<bignum>(dpop()); \
|
||||
bignum * x = untag<bignum>(dpop());
|
||||
|
||||
inline void factor_vm::primitive_bignum_eq()
|
||||
void factor_vm::primitive_bignum_eq()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_equal_p(x,y));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_eq)
|
||||
|
||||
inline void factor_vm::primitive_bignum_add()
|
||||
void factor_vm::primitive_bignum_add()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_add(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_add)
|
||||
|
||||
inline void factor_vm::primitive_bignum_subtract()
|
||||
void factor_vm::primitive_bignum_subtract()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_subtract(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_subtract)
|
||||
|
||||
inline void factor_vm::primitive_bignum_multiply()
|
||||
void factor_vm::primitive_bignum_multiply()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_multiply(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_multiply)
|
||||
|
||||
inline void factor_vm::primitive_bignum_divint()
|
||||
void factor_vm::primitive_bignum_divint()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_quotient(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_divint)
|
||||
|
||||
inline void factor_vm::primitive_bignum_divmod()
|
||||
void factor_vm::primitive_bignum_divmod()
|
||||
{
|
||||
bignum *q, *r;
|
||||
POP_BIGNUMS(x,y);
|
||||
|
@ -165,104 +141,78 @@ inline void factor_vm::primitive_bignum_divmod()
|
|||
dpush(tag<bignum>(r));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_divmod)
|
||||
|
||||
inline void factor_vm::primitive_bignum_mod()
|
||||
void factor_vm::primitive_bignum_mod()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_remainder(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_mod)
|
||||
|
||||
inline void factor_vm::primitive_bignum_and()
|
||||
void factor_vm::primitive_bignum_and()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_bitwise_and(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_and)
|
||||
|
||||
inline void factor_vm::primitive_bignum_or()
|
||||
void factor_vm::primitive_bignum_or()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_or)
|
||||
|
||||
inline void factor_vm::primitive_bignum_xor()
|
||||
void factor_vm::primitive_bignum_xor()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_xor)
|
||||
|
||||
inline void factor_vm::primitive_bignum_shift()
|
||||
void factor_vm::primitive_bignum_shift()
|
||||
{
|
||||
fixnum y = untag_fixnum(dpop());
|
||||
bignum* x = untag<bignum>(dpop());
|
||||
dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_shift)
|
||||
|
||||
inline void factor_vm::primitive_bignum_less()
|
||||
void factor_vm::primitive_bignum_less()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) == bignum_comparison_less);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_less)
|
||||
|
||||
inline void factor_vm::primitive_bignum_lesseq()
|
||||
void factor_vm::primitive_bignum_lesseq()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_lesseq)
|
||||
|
||||
inline void factor_vm::primitive_bignum_greater()
|
||||
void factor_vm::primitive_bignum_greater()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_greater)
|
||||
|
||||
inline void factor_vm::primitive_bignum_greatereq()
|
||||
void factor_vm::primitive_bignum_greatereq()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) != bignum_comparison_less);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_greatereq)
|
||||
|
||||
inline void factor_vm::primitive_bignum_not()
|
||||
void factor_vm::primitive_bignum_not()
|
||||
{
|
||||
drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_not)
|
||||
|
||||
inline void factor_vm::primitive_bignum_bitp()
|
||||
void factor_vm::primitive_bignum_bitp()
|
||||
{
|
||||
fixnum bit = to_fixnum(dpop());
|
||||
bignum *x = untag<bignum>(dpop());
|
||||
box_boolean(bignum_logbitp(bit,x));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_bitp)
|
||||
|
||||
inline void factor_vm::primitive_bignum_log2()
|
||||
void factor_vm::primitive_bignum_log2()
|
||||
{
|
||||
drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_log2)
|
||||
|
||||
unsigned int factor_vm::bignum_producer(unsigned int digit)
|
||||
{
|
||||
unsigned char *ptr = (unsigned char *)alien_offset(dpeek());
|
||||
|
@ -274,15 +224,13 @@ unsigned int bignum_producer(unsigned int digit, factor_vm *myvm)
|
|||
return myvm->bignum_producer(digit);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_byte_array_to_bignum()
|
||||
void factor_vm::primitive_byte_array_to_bignum()
|
||||
{
|
||||
cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
|
||||
bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
|
||||
drepl(tag<bignum>(result));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(byte_array_to_bignum)
|
||||
|
||||
cell factor_vm::unbox_array_size()
|
||||
{
|
||||
switch(tagged<object>(dpeek()).type())
|
||||
|
@ -316,21 +264,17 @@ cell factor_vm::unbox_array_size()
|
|||
return 0; /* can't happen */
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_fixnum_to_float()
|
||||
void factor_vm::primitive_fixnum_to_float()
|
||||
{
|
||||
drepl(allot_float(fixnum_to_float(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(fixnum_to_float)
|
||||
|
||||
inline void factor_vm::primitive_bignum_to_float()
|
||||
void factor_vm::primitive_bignum_to_float()
|
||||
{
|
||||
drepl(allot_float(bignum_to_float(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bignum_to_float)
|
||||
|
||||
inline void factor_vm::primitive_str_to_float()
|
||||
void factor_vm::primitive_str_to_float()
|
||||
{
|
||||
byte_array *bytes = untag_check<byte_array>(dpeek());
|
||||
cell capacity = array_capacity(bytes);
|
||||
|
@ -344,129 +288,97 @@ inline void factor_vm::primitive_str_to_float()
|
|||
drepl(F);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(str_to_float)
|
||||
|
||||
inline void factor_vm::primitive_float_to_str()
|
||||
void factor_vm::primitive_float_to_str()
|
||||
{
|
||||
byte_array *array = allot_byte_array(33);
|
||||
snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
|
||||
dpush(tag<byte_array>(array));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_to_str)
|
||||
|
||||
#define POP_FLOATS(x,y) \
|
||||
double y = untag_float(dpop()); \
|
||||
double x = untag_float(dpop());
|
||||
|
||||
inline void factor_vm::primitive_float_eq()
|
||||
void factor_vm::primitive_float_eq()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x == y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_eq)
|
||||
|
||||
inline void factor_vm::primitive_float_add()
|
||||
void factor_vm::primitive_float_add()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x + y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_add)
|
||||
|
||||
inline void factor_vm::primitive_float_subtract()
|
||||
void factor_vm::primitive_float_subtract()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x - y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_subtract)
|
||||
|
||||
inline void factor_vm::primitive_float_multiply()
|
||||
void factor_vm::primitive_float_multiply()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x * y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_multiply)
|
||||
|
||||
inline void factor_vm::primitive_float_divfloat()
|
||||
void factor_vm::primitive_float_divfloat()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x / y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_divfloat)
|
||||
|
||||
inline void factor_vm::primitive_float_mod()
|
||||
void factor_vm::primitive_float_mod()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(fmod(x,y));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_mod)
|
||||
|
||||
inline void factor_vm::primitive_float_less()
|
||||
void factor_vm::primitive_float_less()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x < y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_less)
|
||||
|
||||
inline void factor_vm::primitive_float_lesseq()
|
||||
void factor_vm::primitive_float_lesseq()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x <= y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_lesseq)
|
||||
|
||||
inline void factor_vm::primitive_float_greater()
|
||||
void factor_vm::primitive_float_greater()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x > y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_greater)
|
||||
|
||||
inline void factor_vm::primitive_float_greatereq()
|
||||
void factor_vm::primitive_float_greatereq()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x >= y);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_greatereq)
|
||||
|
||||
inline void factor_vm::primitive_float_bits()
|
||||
void factor_vm::primitive_float_bits()
|
||||
{
|
||||
box_unsigned_4(float_bits(untag_float_check(dpop())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(float_bits)
|
||||
|
||||
inline void factor_vm::primitive_bits_float()
|
||||
void factor_vm::primitive_bits_float()
|
||||
{
|
||||
box_float(bits_float(to_cell(dpop())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bits_float)
|
||||
|
||||
inline void factor_vm::primitive_double_bits()
|
||||
void factor_vm::primitive_double_bits()
|
||||
{
|
||||
box_unsigned_8(double_bits(untag_float_check(dpop())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(double_bits)
|
||||
|
||||
inline void factor_vm::primitive_bits_double()
|
||||
void factor_vm::primitive_bits_double()
|
||||
{
|
||||
box_double(bits_double(to_unsigned_8(dpop())));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(bits_double)
|
||||
|
||||
fixnum factor_vm::to_fixnum(cell tagged)
|
||||
{
|
||||
switch(TAG(tagged))
|
||||
|
|
107
vm/math.hpp
107
vm/math.hpp
|
@ -5,61 +5,60 @@ static const fixnum fixnum_max = (((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)) - 1)
|
|||
static const fixnum fixnum_min = (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)));
|
||||
static const fixnum array_size_max = ((cell)1 << (WORD_SIZE - TAG_BITS - 2));
|
||||
|
||||
inline cell factor_vm::allot_integer(fixnum x)
|
||||
{
|
||||
if(x < fixnum_min || x > fixnum_max)
|
||||
return tag<bignum>(fixnum_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
inline cell factor_vm::allot_cell(cell x)
|
||||
{
|
||||
if(x > (cell)fixnum_max)
|
||||
return tag<bignum>(cell_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
inline cell factor_vm::allot_float(double n)
|
||||
{
|
||||
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
|
||||
flo->n = n;
|
||||
return tag(flo);
|
||||
}
|
||||
|
||||
inline bignum *factor_vm::float_to_bignum(cell tagged)
|
||||
{
|
||||
return double_to_bignum(untag_float(tagged));
|
||||
}
|
||||
|
||||
inline double factor_vm::bignum_to_float(cell tagged)
|
||||
{
|
||||
return bignum_to_double(untag<bignum>(tagged));
|
||||
}
|
||||
|
||||
inline double factor_vm::untag_float(cell tagged)
|
||||
{
|
||||
return untag<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline double factor_vm::untag_float_check(cell tagged)
|
||||
{
|
||||
return untag_check<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline fixnum factor_vm::float_to_fixnum(cell tagged)
|
||||
{
|
||||
return (fixnum)untag_float(tagged);
|
||||
}
|
||||
|
||||
inline double factor_vm::fixnum_to_float(cell tagged)
|
||||
{
|
||||
return (double)untag_fixnum(tagged);
|
||||
}
|
||||
|
||||
// defined in assembler
|
||||
PRIMITIVE(fixnum_add);
|
||||
PRIMITIVE(fixnum_subtract);
|
||||
PRIMITIVE(fixnum_multiply);
|
||||
|
||||
PRIMITIVE(bignum_to_fixnum);
|
||||
PRIMITIVE(float_to_fixnum);
|
||||
|
||||
PRIMITIVE(fixnum_divint);
|
||||
PRIMITIVE(fixnum_divmod);
|
||||
PRIMITIVE(fixnum_shift);
|
||||
|
||||
PRIMITIVE(fixnum_to_bignum);
|
||||
PRIMITIVE(float_to_bignum);
|
||||
PRIMITIVE(bignum_eq);
|
||||
PRIMITIVE(bignum_add);
|
||||
PRIMITIVE(bignum_subtract);
|
||||
PRIMITIVE(bignum_multiply);
|
||||
PRIMITIVE(bignum_divint);
|
||||
PRIMITIVE(bignum_divmod);
|
||||
PRIMITIVE(bignum_mod);
|
||||
PRIMITIVE(bignum_and);
|
||||
PRIMITIVE(bignum_or);
|
||||
PRIMITIVE(bignum_xor);
|
||||
PRIMITIVE(bignum_shift);
|
||||
PRIMITIVE(bignum_less);
|
||||
PRIMITIVE(bignum_lesseq);
|
||||
PRIMITIVE(bignum_greater);
|
||||
PRIMITIVE(bignum_greatereq);
|
||||
PRIMITIVE(bignum_not);
|
||||
PRIMITIVE(bignum_bitp);
|
||||
PRIMITIVE(bignum_log2);
|
||||
PRIMITIVE(byte_array_to_bignum);
|
||||
|
||||
PRIMITIVE(fixnum_to_float);
|
||||
PRIMITIVE(bignum_to_float);
|
||||
PRIMITIVE(str_to_float);
|
||||
PRIMITIVE(float_to_str);
|
||||
PRIMITIVE(float_to_bits);
|
||||
|
||||
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(float_bits);
|
||||
PRIMITIVE(bits_float);
|
||||
PRIMITIVE(double_bits);
|
||||
PRIMITIVE(bits_double);
|
||||
|
||||
VM_C_API void box_float(float flo, factor_vm *vm);
|
||||
VM_C_API float to_float(cell value, factor_vm *vm);
|
||||
|
|
|
@ -74,15 +74,13 @@ void factor_vm::ffi_dlclose(dll *dll)
|
|||
dll->dll = NULL;
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_existsp()
|
||||
void factor_vm::primitive_existsp()
|
||||
{
|
||||
struct stat sb;
|
||||
char *path = (char *)(untag_check<byte_array>(dpop()) + 1);
|
||||
box_boolean(stat(path,&sb) >= 0);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(existsp)
|
||||
|
||||
segment::segment(factor_vm *myvm_, cell size_)
|
||||
{
|
||||
myvm = myvm_;
|
||||
|
@ -132,7 +130,6 @@ stack_frame *factor_vm::uap_stack_pointer(void *uap)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
void factor_vm::memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
signal_fault_addr = (cell)siginfo->si_addr;
|
||||
|
|
|
@ -30,8 +30,6 @@ char *getenv(char *name)
|
|||
return 0; /* unreachable */
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(os_envs)
|
||||
|
||||
void c_to_factor_toplevel(cell quot)
|
||||
{
|
||||
c_to_factor(quot,vm);
|
||||
|
|
|
@ -90,14 +90,12 @@ const vm_char *factor_vm::vm_executable_path()
|
|||
return safe_strdup(full_path);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_existsp()
|
||||
void factor_vm::primitive_existsp()
|
||||
{
|
||||
vm_char *path = untag_check<byte_array>(dpop())->data<vm_char>();
|
||||
box_boolean(windows_stat(path));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(existsp)
|
||||
|
||||
segment::segment(factor_vm *myvm_, cell size_)
|
||||
{
|
||||
myvm = myvm_;
|
||||
|
|
|
@ -165,4 +165,127 @@ const primitive_type primitives[] = {
|
|||
primitive_vm_ptr,
|
||||
};
|
||||
|
||||
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(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)
|
||||
|
||||
}
|
||||
|
|
|
@ -17,4 +17,159 @@ namespace factor
|
|||
}
|
||||
#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);
|
||||
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(alien_signed_cell);
|
||||
PRIMITIVE(set_alien_signed_cell);
|
||||
PRIMITIVE(alien_unsigned_cell);
|
||||
PRIMITIVE(set_alien_unsigned_cell);
|
||||
PRIMITIVE(alien_signed_8);
|
||||
PRIMITIVE(set_alien_signed_8);
|
||||
PRIMITIVE(alien_unsigned_8);
|
||||
PRIMITIVE(set_alien_unsigned_8);
|
||||
PRIMITIVE(alien_signed_4);
|
||||
PRIMITIVE(set_alien_signed_4);
|
||||
PRIMITIVE(alien_unsigned_4);
|
||||
PRIMITIVE(set_alien_unsigned_4);
|
||||
PRIMITIVE(alien_signed_2);
|
||||
PRIMITIVE(set_alien_signed_2);
|
||||
PRIMITIVE(alien_unsigned_2);
|
||||
PRIMITIVE(set_alien_unsigned_2);
|
||||
PRIMITIVE(alien_signed_1);
|
||||
PRIMITIVE(set_alien_signed_1);
|
||||
PRIMITIVE(alien_unsigned_1);
|
||||
PRIMITIVE(set_alien_unsigned_1);
|
||||
PRIMITIVE(alien_float);
|
||||
PRIMITIVE(set_alien_float);
|
||||
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(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);
|
||||
|
||||
}
|
||||
|
|
|
@ -44,14 +44,12 @@ void factor_vm::set_profiling(bool profiling)
|
|||
}
|
||||
|
||||
/* Update XTs in code heap */
|
||||
iterate_code_heap(factor::relocate_code_block);
|
||||
iterate_code_heap(&factor_vm::relocate_code_block);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_profiling()
|
||||
void factor_vm::primitive_profiling()
|
||||
{
|
||||
set_profiling(to_boolean(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(profiling)
|
||||
|
||||
}
|
||||
|
|
|
@ -1,6 +1,4 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE(profiling);
|
||||
|
||||
}
|
||||
|
|
|
@ -290,15 +290,13 @@ void factor_vm::jit_compile(cell quot_, bool relocating)
|
|||
if(relocating) relocate_code_block(compiled);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_jit_compile()
|
||||
void factor_vm::primitive_jit_compile()
|
||||
{
|
||||
jit_compile(dpop(),true);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(jit_compile)
|
||||
|
||||
/* push a new quotation on the stack */
|
||||
inline void factor_vm::primitive_array_to_quotation()
|
||||
void factor_vm::primitive_array_to_quotation()
|
||||
{
|
||||
quotation *quot = allot<quotation>(sizeof(quotation));
|
||||
quot->array = dpeek();
|
||||
|
@ -309,16 +307,12 @@ inline void factor_vm::primitive_array_to_quotation()
|
|||
drepl(tag<quotation>(quot));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(array_to_quotation)
|
||||
|
||||
inline void factor_vm::primitive_quotation_xt()
|
||||
void factor_vm::primitive_quotation_xt()
|
||||
{
|
||||
quotation *quot = untag_check<quotation>(dpeek());
|
||||
drepl(allot_cell((cell)quot->xt));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(quotation_xt)
|
||||
|
||||
void factor_vm::compile_all_words()
|
||||
{
|
||||
gc_root<array> words(find_all_words(),this);
|
||||
|
@ -336,7 +330,7 @@ void factor_vm::compile_all_words()
|
|||
|
||||
}
|
||||
|
||||
iterate_code_heap(factor::relocate_code_block);
|
||||
iterate_code_heap(&factor_vm::relocate_code_block);
|
||||
}
|
||||
|
||||
/* Allocates memory */
|
||||
|
@ -366,13 +360,11 @@ VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm
|
|||
return VM_PTR->lazy_jit_compile_impl(quot_,stack);
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_quot_compiled_p()
|
||||
void factor_vm::primitive_quot_compiled_p()
|
||||
{
|
||||
tagged<quotation> quot(dpop());
|
||||
quot.untag_check(this);
|
||||
dpush(tag_boolean(quot->code != NULL));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(quot_compiled_p)
|
||||
|
||||
}
|
||||
|
|
|
@ -23,13 +23,6 @@ struct quotation_jit : public jit {
|
|||
void iterate_quotation();
|
||||
};
|
||||
|
||||
PRIMITIVE(jit_compile);
|
||||
|
||||
PRIMITIVE(array_to_quotation);
|
||||
PRIMITIVE(quotation_xt);
|
||||
|
||||
VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm);
|
||||
|
||||
PRIMITIVE(quot_compiled_p);
|
||||
|
||||
}
|
||||
|
|
32
vm/run.cpp
32
vm/run.cpp
|
@ -3,45 +3,35 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
inline void factor_vm::primitive_getenv()
|
||||
void factor_vm::primitive_getenv()
|
||||
{
|
||||
fixnum e = untag_fixnum(dpeek());
|
||||
drepl(userenv[e]);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(getenv)
|
||||
|
||||
inline void factor_vm::primitive_setenv()
|
||||
void factor_vm::primitive_setenv()
|
||||
{
|
||||
fixnum e = untag_fixnum(dpop());
|
||||
cell value = dpop();
|
||||
userenv[e] = value;
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(setenv)
|
||||
|
||||
inline void factor_vm::primitive_exit()
|
||||
void factor_vm::primitive_exit()
|
||||
{
|
||||
exit(to_fixnum(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(exit)
|
||||
|
||||
inline void factor_vm::primitive_micros()
|
||||
void factor_vm::primitive_micros()
|
||||
{
|
||||
box_unsigned_8(current_micros());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(micros)
|
||||
|
||||
inline void factor_vm::primitive_sleep()
|
||||
void factor_vm::primitive_sleep()
|
||||
{
|
||||
sleep_micros(to_cell(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(sleep)
|
||||
|
||||
inline void factor_vm::primitive_set_slot()
|
||||
void factor_vm::primitive_set_slot()
|
||||
{
|
||||
fixnum slot = untag_fixnum(dpop());
|
||||
object *obj = untag<object>(dpop());
|
||||
|
@ -51,9 +41,7 @@ inline void factor_vm::primitive_set_slot()
|
|||
write_barrier(obj);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(set_slot)
|
||||
|
||||
inline void factor_vm::primitive_load_locals()
|
||||
void factor_vm::primitive_load_locals()
|
||||
{
|
||||
fixnum count = untag_fixnum(dpop());
|
||||
memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);
|
||||
|
@ -61,8 +49,6 @@ inline void factor_vm::primitive_load_locals()
|
|||
rs += sizeof(cell) * count;
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(load_locals)
|
||||
|
||||
cell factor_vm::clone_object(cell obj_)
|
||||
{
|
||||
gc_root<object> obj(obj_,this);
|
||||
|
@ -78,11 +64,9 @@ cell factor_vm::clone_object(cell obj_)
|
|||
}
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_clone()
|
||||
void factor_vm::primitive_clone()
|
||||
{
|
||||
drepl(clone_object(dpeek()));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(clone)
|
||||
|
||||
}
|
||||
|
|
|
@ -99,15 +99,6 @@ inline static bool save_env_p(cell i)
|
|||
return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV;
|
||||
}
|
||||
|
||||
PRIMITIVE(getenv);
|
||||
PRIMITIVE(setenv);
|
||||
PRIMITIVE(exit);
|
||||
PRIMITIVE(micros);
|
||||
PRIMITIVE(sleep);
|
||||
PRIMITIVE(set_slot);
|
||||
PRIMITIVE(load_locals);
|
||||
PRIMITIVE(clone);
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -99,15 +99,13 @@ string *factor_vm::allot_string(cell capacity, cell fill)
|
|||
return str.untagged();
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_string()
|
||||
void factor_vm::primitive_string()
|
||||
{
|
||||
cell initial = to_cell(dpop());
|
||||
cell length = unbox_array_size();
|
||||
dpush(tag<string>(allot_string(length,initial)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(string)
|
||||
|
||||
bool factor_vm::reallot_string_in_place_p(string *str, cell capacity)
|
||||
{
|
||||
return in_zone(&nursery,str)
|
||||
|
@ -157,25 +155,21 @@ string* factor_vm::reallot_string(string *str_, cell capacity)
|
|||
}
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_resize_string()
|
||||
void factor_vm::primitive_resize_string()
|
||||
{
|
||||
string* str = untag_check<string>(dpop());
|
||||
cell capacity = unbox_array_size();
|
||||
dpush(tag<string>(reallot_string(str,capacity)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(resize_string)
|
||||
|
||||
inline void factor_vm::primitive_string_nth()
|
||||
void factor_vm::primitive_string_nth()
|
||||
{
|
||||
string *str = untag<string>(dpop());
|
||||
cell index = untag_fixnum(dpop());
|
||||
dpush(tag_fixnum(string_nth(str,index)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(string_nth)
|
||||
|
||||
inline void factor_vm::primitive_set_string_nth_fast()
|
||||
void factor_vm::primitive_set_string_nth_fast()
|
||||
{
|
||||
string *str = untag<string>(dpop());
|
||||
cell index = untag_fixnum(dpop());
|
||||
|
@ -183,9 +177,7 @@ inline void factor_vm::primitive_set_string_nth_fast()
|
|||
set_string_nth_fast(str,index,value);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(set_string_nth_fast)
|
||||
|
||||
inline void factor_vm::primitive_set_string_nth_slow()
|
||||
void factor_vm::primitive_set_string_nth_slow()
|
||||
{
|
||||
string *str = untag<string>(dpop());
|
||||
cell index = untag_fixnum(dpop());
|
||||
|
@ -193,6 +185,4 @@ inline void factor_vm::primitive_set_string_nth_slow()
|
|||
set_string_nth_slow(str,index,value);
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(set_string_nth_slow)
|
||||
|
||||
}
|
||||
|
|
|
@ -11,11 +11,4 @@ inline static cell string_size(cell size)
|
|||
return sizeof(string) + size;
|
||||
}
|
||||
|
||||
PRIMITIVE(string);
|
||||
PRIMITIVE(resize_string);
|
||||
|
||||
PRIMITIVE(string_nth);
|
||||
PRIMITIVE(set_string_nth_slow);
|
||||
PRIMITIVE(set_string_nth_fast);
|
||||
|
||||
}
|
||||
|
|
|
@ -12,7 +12,7 @@ tuple *factor_vm::allot_tuple(cell layout_)
|
|||
return t.untagged();
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_tuple()
|
||||
void factor_vm::primitive_tuple()
|
||||
{
|
||||
gc_root<tuple_layout> layout(dpop(),this);
|
||||
tuple *t = allot_tuple(layout.value());
|
||||
|
@ -23,10 +23,8 @@ inline void factor_vm::primitive_tuple()
|
|||
dpush(tag<tuple>(t));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(tuple)
|
||||
|
||||
/* push a new tuple on the stack, filling its slots from the stack */
|
||||
inline void factor_vm::primitive_tuple_boa()
|
||||
void factor_vm::primitive_tuple_boa()
|
||||
{
|
||||
gc_root<tuple_layout> layout(dpop(),this);
|
||||
gc_root<tuple> t(allot_tuple(layout.value()),this);
|
||||
|
@ -36,6 +34,4 @@ inline void factor_vm::primitive_tuple_boa()
|
|||
dpush(t.value());
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(tuple_boa)
|
||||
|
||||
}
|
||||
|
|
|
@ -7,8 +7,4 @@ inline static cell tuple_size(tuple_layout *layout)
|
|||
return sizeof(tuple) + size * sizeof(cell);
|
||||
}
|
||||
|
||||
PRIMITIVE(tuple);
|
||||
PRIMITIVE(tuple_boa);
|
||||
PRIMITIVE(tuple_layout);
|
||||
|
||||
}
|
||||
|
|
121
vm/vm-data.hpp
121
vm/vm-data.hpp
|
@ -1,121 +0,0 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
struct factor_vm_data {
|
||||
// if you change this struct, also change vm.factor k--------
|
||||
context *stack_chain;
|
||||
zone nursery; /* new objects are allocated here */
|
||||
cell cards_offset;
|
||||
cell decks_offset;
|
||||
cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
|
||||
|
||||
// -------------------------------
|
||||
|
||||
// contexts
|
||||
cell ds_size, rs_size;
|
||||
context *unused_contexts;
|
||||
|
||||
// run
|
||||
cell T; /* Canonical T object. It's just a word */
|
||||
|
||||
// profiler
|
||||
bool profiling_p;
|
||||
|
||||
// errors
|
||||
/* Global variables used to pass fault handler state from signal handler to
|
||||
user-space */
|
||||
cell signal_number;
|
||||
cell signal_fault_addr;
|
||||
unsigned int signal_fpu_status;
|
||||
stack_frame *signal_callstack_top;
|
||||
|
||||
//data_heap
|
||||
bool secure_gc; /* Set by the -securegc command line argument */
|
||||
bool gc_off; /* GC is off during heap walking */
|
||||
data_heap *data;
|
||||
/* A heap walk allows useful things to be done, like finding all
|
||||
references to an object for debugging purposes. */
|
||||
cell heap_scan_ptr;
|
||||
//write barrier
|
||||
cell allot_markers_offset;
|
||||
//data_gc
|
||||
/* used during garbage collection only */
|
||||
zone *newspace;
|
||||
bool performing_gc;
|
||||
bool performing_compaction;
|
||||
cell collecting_gen;
|
||||
/* if true, we are collecting aging space for the second time, so if it is still
|
||||
full, we go on to collect tenured */
|
||||
bool collecting_aging_again;
|
||||
/* in case a generation fills up in the middle of a gc, we jump back
|
||||
up to try collecting the next generation. */
|
||||
jmp_buf gc_jmp;
|
||||
gc_stats stats[max_gen_count];
|
||||
u64 cards_scanned;
|
||||
u64 decks_scanned;
|
||||
u64 card_scan_time;
|
||||
cell code_heap_scans;
|
||||
/* What generation was being collected when copy_code_heap_roots() was last
|
||||
called? Until the next call to add_code_block(), future
|
||||
collections of younger generations don't have to touch the code
|
||||
heap. */
|
||||
cell last_code_heap_scan;
|
||||
/* sometimes we grow the heap */
|
||||
bool growing_data_heap;
|
||||
data_heap *old_data_heap;
|
||||
|
||||
// local roots
|
||||
/* If a runtime function needs to call another function which potentially
|
||||
allocates memory, it must wrap any local variable references to Factor
|
||||
objects in gc_root instances */
|
||||
std::vector<cell> gc_locals;
|
||||
std::vector<cell> gc_bignums;
|
||||
|
||||
//debug
|
||||
bool fep_disabled;
|
||||
bool full_output;
|
||||
cell look_for;
|
||||
cell obj;
|
||||
|
||||
//math
|
||||
cell bignum_zero;
|
||||
cell bignum_pos_one;
|
||||
cell bignum_neg_one;
|
||||
|
||||
//code_heap
|
||||
heap *code;
|
||||
unordered_map<heap_block *, char *> forwarding;
|
||||
|
||||
//image
|
||||
cell code_relocation_base;
|
||||
cell data_relocation_base;
|
||||
|
||||
//dispatch
|
||||
cell megamorphic_cache_hits;
|
||||
cell megamorphic_cache_misses;
|
||||
|
||||
//inline cache
|
||||
cell max_pic_size;
|
||||
cell cold_call_to_ic_transitions;
|
||||
cell ic_to_pic_transitions;
|
||||
cell pic_to_mega_transitions;
|
||||
cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
|
||||
|
||||
factor_vm_data()
|
||||
: profiling_p(false),
|
||||
secure_gc(false),
|
||||
gc_off(false),
|
||||
performing_gc(false),
|
||||
performing_compaction(false),
|
||||
collecting_aging_again(false),
|
||||
growing_data_heap(false),
|
||||
fep_disabled(false),
|
||||
full_output(false),
|
||||
max_pic_size(0)
|
||||
{
|
||||
memset(this,0,sizeof(this)); // just to make sure
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
}
|
473
vm/vm.hpp
473
vm/vm.hpp
|
@ -1,11 +1,19 @@
|
|||
#include "vm-data.hpp"
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
struct factor_vm : factor_vm_data {
|
||||
struct factor_vm
|
||||
{
|
||||
// First five fields accessed directly by assembler. See vm.factor
|
||||
context *stack_chain;
|
||||
zone nursery; /* new objects are allocated here */
|
||||
cell cards_offset;
|
||||
cell decks_offset;
|
||||
cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
|
||||
|
||||
// contexts
|
||||
cell ds_size, rs_size;
|
||||
context *unused_contexts;
|
||||
|
||||
void reset_datastack();
|
||||
void reset_retainstack();
|
||||
void fix_stacks();
|
||||
|
@ -17,30 +25,41 @@ struct factor_vm : factor_vm_data {
|
|||
void init_stacks(cell ds_size_, cell rs_size_);
|
||||
bool stack_to_array(cell bottom, cell top);
|
||||
cell array_to_stack(array *array, cell bottom);
|
||||
inline void primitive_datastack();
|
||||
inline void primitive_retainstack();
|
||||
inline void primitive_set_datastack();
|
||||
inline void primitive_set_retainstack();
|
||||
inline void primitive_check_datastack();
|
||||
void primitive_datastack();
|
||||
void primitive_retainstack();
|
||||
void primitive_set_datastack();
|
||||
void primitive_set_retainstack();
|
||||
void primitive_check_datastack();
|
||||
|
||||
// run
|
||||
inline void primitive_getenv();
|
||||
inline void primitive_setenv();
|
||||
inline void primitive_exit();
|
||||
inline void primitive_micros();
|
||||
inline void primitive_sleep();
|
||||
inline void primitive_set_slot();
|
||||
inline void primitive_load_locals();
|
||||
cell T; /* Canonical T object. It's just a word */
|
||||
|
||||
void primitive_getenv();
|
||||
void primitive_setenv();
|
||||
void primitive_exit();
|
||||
void primitive_micros();
|
||||
void primitive_sleep();
|
||||
void primitive_set_slot();
|
||||
void primitive_load_locals();
|
||||
cell clone_object(cell obj_);
|
||||
inline void primitive_clone();
|
||||
void primitive_clone();
|
||||
|
||||
// profiler
|
||||
bool profiling_p;
|
||||
|
||||
void init_profiler();
|
||||
code_block *compile_profiling_stub(cell word_);
|
||||
void set_profiling(bool profiling);
|
||||
inline void primitive_profiling();
|
||||
void primitive_profiling();
|
||||
|
||||
// errors
|
||||
/* Global variables used to pass fault handler state from signal handler to
|
||||
user-space */
|
||||
cell signal_number;
|
||||
cell signal_fault_addr;
|
||||
unsigned int signal_fpu_status;
|
||||
stack_frame *signal_callstack_top;
|
||||
|
||||
void out_of_memory();
|
||||
void critical_error(const char* msg, cell tagged);
|
||||
void throw_error(cell error, stack_frame *callstack_top);
|
||||
|
@ -50,16 +69,14 @@ struct factor_vm : factor_vm_data {
|
|||
void signal_error(int signal, stack_frame *native_stack);
|
||||
void divide_by_zero_error();
|
||||
void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top);
|
||||
inline void primitive_call_clear();
|
||||
inline void primitive_unimplemented();
|
||||
void primitive_call_clear();
|
||||
void primitive_unimplemented();
|
||||
void memory_signal_handler_impl();
|
||||
void misc_signal_handler_impl();
|
||||
void fp_signal_handler_impl();
|
||||
void type_error(cell type, cell tagged);
|
||||
void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
|
||||
|
||||
//callstack
|
||||
|
||||
// bignum
|
||||
int bignum_equal_p(bignum * x, bignum * y);
|
||||
enum bignum_comparison bignum_compare(bignum * x, bignum * y);
|
||||
|
@ -84,20 +101,20 @@ struct factor_vm : factor_vm_data {
|
|||
void bignum_destructive_add(bignum * bignum, bignum_digit_type n);
|
||||
void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor);
|
||||
void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator,
|
||||
bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
|
||||
bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
|
||||
void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q);
|
||||
bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end,
|
||||
bignum_digit_type guess, bignum_digit_type * u_start);
|
||||
bignum_digit_type guess, bignum_digit_type * u_start);
|
||||
void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator,
|
||||
bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
|
||||
bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
|
||||
void bignum_destructive_normalization(bignum * source, bignum * target, int shift_left);
|
||||
void bignum_destructive_unnormalization(bignum * bignum, int shift_right);
|
||||
bignum_digit_type bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
|
||||
bignum_digit_type v, bignum_digit_type * q) /* return value */;
|
||||
bignum_digit_type v, bignum_digit_type * q) /* return value */;
|
||||
bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
|
||||
bignum_digit_type guess, bignum_digit_type * u);
|
||||
bignum_digit_type guess, bignum_digit_type * u);
|
||||
void bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator,
|
||||
bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
|
||||
bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
|
||||
bignum_digit_type bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator);
|
||||
bignum * bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p);
|
||||
bignum *bignum_digit_to_bignum(bignum_digit_type digit, int negative_p);
|
||||
|
@ -124,6 +141,13 @@ struct factor_vm : factor_vm_data {
|
|||
bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factor_vm *), unsigned int radix, int negative_p);
|
||||
|
||||
//data_heap
|
||||
bool secure_gc; /* Set by the -securegc command line argument */
|
||||
bool gc_off; /* GC is off during heap walking */
|
||||
data_heap *data;
|
||||
/* A heap walk allows useful things to be done, like finding all
|
||||
references to an object for debugging purposes. */
|
||||
cell heap_scan_ptr;
|
||||
|
||||
void init_card_decks();
|
||||
data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
|
||||
void clear_cards(cell from, cell to);
|
||||
|
@ -135,32 +159,99 @@ struct factor_vm : factor_vm_data {
|
|||
void init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_);
|
||||
cell untagged_object_size(object *pointer);
|
||||
cell unaligned_object_size(object *pointer);
|
||||
inline void primitive_size();
|
||||
void primitive_size();
|
||||
cell binary_payload_start(object *pointer);
|
||||
inline void primitive_data_room();
|
||||
void primitive_data_room();
|
||||
void begin_scan();
|
||||
void end_scan();
|
||||
inline void primitive_begin_scan();
|
||||
void primitive_begin_scan();
|
||||
cell next_object();
|
||||
inline void primitive_next_object();
|
||||
inline void primitive_end_scan();
|
||||
void primitive_next_object();
|
||||
void primitive_end_scan();
|
||||
template<typename T> void each_object(T &functor);
|
||||
cell find_all_words();
|
||||
cell object_size(cell tagged);
|
||||
|
||||
|
||||
//write barrier
|
||||
inline card *addr_to_card(cell a);
|
||||
inline cell card_to_addr(card *c);
|
||||
inline cell card_offset(card *c);
|
||||
inline card_deck *addr_to_deck(cell a);
|
||||
inline cell deck_to_addr(card_deck *c);
|
||||
inline card *deck_to_card(card_deck *d);
|
||||
inline card *addr_to_allot_marker(object *a);
|
||||
inline void write_barrier(object *obj);
|
||||
inline void allot_barrier(object *address);
|
||||
cell allot_markers_offset;
|
||||
|
||||
inline card *addr_to_card(cell a)
|
||||
{
|
||||
return (card*)(((cell)(a) >> card_bits) + cards_offset);
|
||||
}
|
||||
|
||||
inline cell card_to_addr(card *c)
|
||||
{
|
||||
return ((cell)c - cards_offset) << card_bits;
|
||||
}
|
||||
|
||||
inline cell card_offset(card *c)
|
||||
{
|
||||
return *(c - (cell)data->cards + (cell)data->allot_markers);
|
||||
}
|
||||
|
||||
inline card_deck *addr_to_deck(cell a)
|
||||
{
|
||||
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
|
||||
}
|
||||
|
||||
inline cell deck_to_addr(card_deck *c)
|
||||
{
|
||||
return ((cell)c - decks_offset) << deck_bits;
|
||||
}
|
||||
|
||||
inline card *deck_to_card(card_deck *d)
|
||||
{
|
||||
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
|
||||
}
|
||||
|
||||
inline card *addr_to_allot_marker(object *a)
|
||||
{
|
||||
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
|
||||
}
|
||||
|
||||
/* the write barrier must be called any time we are potentially storing a
|
||||
pointer from an older generation to a younger one */
|
||||
inline void write_barrier(object *obj)
|
||||
{
|
||||
*addr_to_card((cell)obj) = card_mark_mask;
|
||||
*addr_to_deck((cell)obj) = card_mark_mask;
|
||||
}
|
||||
|
||||
/* we need to remember the first object allocated in the card */
|
||||
inline void allot_barrier(object *address)
|
||||
{
|
||||
card *ptr = addr_to_allot_marker(address);
|
||||
if(*ptr == invalid_allot_marker)
|
||||
*ptr = ((cell)address & addr_card_mask);
|
||||
}
|
||||
|
||||
// data_gc
|
||||
/* used during garbage collection only */
|
||||
zone *newspace;
|
||||
bool performing_gc;
|
||||
bool performing_compaction;
|
||||
cell collecting_gen;
|
||||
/* if true, we are collecting aging space for the second time, so if it is still
|
||||
full, we go on to collect tenured */
|
||||
bool collecting_aging_again;
|
||||
/* in case a generation fills up in the middle of a gc, we jump back
|
||||
up to try collecting the next generation. */
|
||||
jmp_buf gc_jmp;
|
||||
gc_stats stats[max_gen_count];
|
||||
u64 cards_scanned;
|
||||
u64 decks_scanned;
|
||||
u64 card_scan_time;
|
||||
cell code_heap_scans;
|
||||
/* What generation was being collected when copy_code_heap_roots() was last
|
||||
called? Until the next call to add_code_block(), future
|
||||
collections of younger generations don't have to touch the code
|
||||
heap. */
|
||||
cell last_code_heap_scan;
|
||||
/* sometimes we grow the heap */
|
||||
bool growing_data_heap;
|
||||
data_heap *old_data_heap;
|
||||
|
||||
//data_gc
|
||||
void init_data_gc();
|
||||
object *copy_untagged_object_impl(object *pointer, cell size);
|
||||
object *copy_object_impl(object *untagged);
|
||||
|
@ -185,18 +276,57 @@ struct factor_vm : factor_vm_data {
|
|||
void end_gc(cell gc_elapsed);
|
||||
void garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes);
|
||||
void gc();
|
||||
inline void primitive_gc();
|
||||
inline void primitive_gc_stats();
|
||||
void primitive_gc();
|
||||
void primitive_gc_stats();
|
||||
void clear_gc_stats();
|
||||
inline void primitive_become();
|
||||
void primitive_become();
|
||||
void inline_gc(cell *gc_roots_base, cell gc_roots_size);
|
||||
inline bool collecting_accumulation_gen_p();
|
||||
inline object *allot_zone(zone *z, cell a);
|
||||
inline object *allot_object(header header, cell size);
|
||||
template <typename TYPE> TYPE *allot(cell size);
|
||||
inline void check_data_pointer(object *pointer);
|
||||
inline void check_tagged_pointer(cell tagged);
|
||||
inline void primitive_clear_gc_stats();
|
||||
object *allot_object(header header, cell size);
|
||||
void primitive_clear_gc_stats();
|
||||
|
||||
template<typename TYPE> TYPE *allot(cell size)
|
||||
{
|
||||
return (TYPE *)allot_object(header(TYPE::type_number),size);
|
||||
}
|
||||
|
||||
inline bool collecting_accumulation_gen_p()
|
||||
{
|
||||
return ((data->have_aging_p()
|
||||
&& collecting_gen == data->aging()
|
||||
&& !collecting_aging_again)
|
||||
|| collecting_gen == data->tenured());
|
||||
}
|
||||
|
||||
inline void check_data_pointer(object *pointer)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!growing_data_heap)
|
||||
{
|
||||
assert((cell)pointer >= data->seg->start
|
||||
&& (cell)pointer < data->seg->end);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
inline void check_tagged_pointer(cell tagged)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!immediate_p(tagged))
|
||||
{
|
||||
object *obj = untag<object>(tagged);
|
||||
check_data_pointer(obj);
|
||||
obj->h.hi_tag();
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
// local roots
|
||||
/* If a runtime function needs to call another function which potentially
|
||||
allocates memory, it must wrap any local variable references to Factor
|
||||
objects in gc_root instances */
|
||||
std::vector<cell> gc_locals;
|
||||
std::vector<cell> gc_bignums;
|
||||
|
||||
// generic arrays
|
||||
template <typename T> T *allot_array_internal(cell capacity);
|
||||
|
@ -204,6 +334,11 @@ struct factor_vm : factor_vm_data {
|
|||
template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
|
||||
|
||||
//debug
|
||||
bool fep_disabled;
|
||||
bool full_output;
|
||||
cell look_for;
|
||||
cell obj;
|
||||
|
||||
void print_chars(string* str);
|
||||
void print_word(word* word, cell nesting);
|
||||
void print_factor_string(string* str);
|
||||
|
@ -225,15 +360,15 @@ struct factor_vm : factor_vm_data {
|
|||
void find_data_references(cell look_for_);
|
||||
void dump_code_heap();
|
||||
void factorbug();
|
||||
inline void primitive_die();
|
||||
void primitive_die();
|
||||
|
||||
//arrays
|
||||
array *allot_array(cell capacity, cell fill_);
|
||||
inline void primitive_array();
|
||||
void primitive_array();
|
||||
cell allot_array_1(cell obj_);
|
||||
cell allot_array_2(cell v1_, cell v2_);
|
||||
cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_);
|
||||
inline void primitive_resize_array();
|
||||
void primitive_resize_array();
|
||||
inline void set_array_nth(array *array, cell slot, cell value);
|
||||
|
||||
//strings
|
||||
|
@ -244,13 +379,13 @@ struct factor_vm : factor_vm_data {
|
|||
string *allot_string_internal(cell capacity);
|
||||
void fill_string(string *str_, cell start, cell capacity, cell fill);
|
||||
string *allot_string(cell capacity, cell fill);
|
||||
inline void primitive_string();
|
||||
void primitive_string();
|
||||
bool reallot_string_in_place_p(string *str, cell capacity);
|
||||
string* reallot_string(string *str_, cell capacity);
|
||||
inline void primitive_resize_string();
|
||||
inline void primitive_string_nth();
|
||||
inline void primitive_set_string_nth_fast();
|
||||
inline void primitive_set_string_nth_slow();
|
||||
void primitive_resize_string();
|
||||
void primitive_string_nth();
|
||||
void primitive_set_string_nth_fast();
|
||||
void primitive_set_string_nth_slow();
|
||||
|
||||
//booleans
|
||||
void box_boolean(bool value);
|
||||
|
@ -259,28 +394,32 @@ struct factor_vm : factor_vm_data {
|
|||
|
||||
//byte arrays
|
||||
byte_array *allot_byte_array(cell size);
|
||||
inline void primitive_byte_array();
|
||||
inline void primitive_uninitialized_byte_array();
|
||||
inline void primitive_resize_byte_array();
|
||||
void primitive_byte_array();
|
||||
void primitive_uninitialized_byte_array();
|
||||
void primitive_resize_byte_array();
|
||||
|
||||
//tuples
|
||||
tuple *allot_tuple(cell layout_);
|
||||
inline void primitive_tuple();
|
||||
inline void primitive_tuple_boa();
|
||||
void primitive_tuple();
|
||||
void primitive_tuple_boa();
|
||||
|
||||
//words
|
||||
word *allot_word(cell name_, cell vocab_, cell hashcode_);
|
||||
inline void primitive_word();
|
||||
inline void primitive_word_xt();
|
||||
void primitive_word();
|
||||
void primitive_word_xt();
|
||||
void update_word_xt(cell w_);
|
||||
inline void primitive_optimized_p();
|
||||
inline void primitive_wrapper();
|
||||
void primitive_optimized_p();
|
||||
void primitive_wrapper();
|
||||
|
||||
//math
|
||||
inline void primitive_bignum_to_fixnum();
|
||||
inline void primitive_float_to_fixnum();
|
||||
inline void primitive_fixnum_divint();
|
||||
inline void primitive_fixnum_divmod();
|
||||
cell bignum_zero;
|
||||
cell bignum_pos_one;
|
||||
cell bignum_neg_one;
|
||||
|
||||
void primitive_bignum_to_fixnum();
|
||||
void primitive_float_to_fixnum();
|
||||
void primitive_fixnum_divint();
|
||||
void primitive_fixnum_divmod();
|
||||
bignum *fixnum_to_bignum(fixnum);
|
||||
bignum *cell_to_bignum(cell);
|
||||
bignum *long_long_to_bignum(s64 n);
|
||||
|
@ -288,48 +427,48 @@ struct factor_vm : factor_vm_data {
|
|||
inline fixnum sign_mask(fixnum x);
|
||||
inline fixnum branchless_max(fixnum x, fixnum y);
|
||||
inline fixnum branchless_abs(fixnum x);
|
||||
inline void primitive_fixnum_shift();
|
||||
inline void primitive_fixnum_to_bignum();
|
||||
inline void primitive_float_to_bignum();
|
||||
inline void primitive_bignum_eq();
|
||||
inline void primitive_bignum_add();
|
||||
inline void primitive_bignum_subtract();
|
||||
inline void primitive_bignum_multiply();
|
||||
inline void primitive_bignum_divint();
|
||||
inline void primitive_bignum_divmod();
|
||||
inline void primitive_bignum_mod();
|
||||
inline void primitive_bignum_and();
|
||||
inline void primitive_bignum_or();
|
||||
inline void primitive_bignum_xor();
|
||||
inline void primitive_bignum_shift();
|
||||
inline void primitive_bignum_less();
|
||||
inline void primitive_bignum_lesseq();
|
||||
inline void primitive_bignum_greater();
|
||||
inline void primitive_bignum_greatereq();
|
||||
inline void primitive_bignum_not();
|
||||
inline void primitive_bignum_bitp();
|
||||
inline void primitive_bignum_log2();
|
||||
void primitive_fixnum_shift();
|
||||
void primitive_fixnum_to_bignum();
|
||||
void primitive_float_to_bignum();
|
||||
void primitive_bignum_eq();
|
||||
void primitive_bignum_add();
|
||||
void primitive_bignum_subtract();
|
||||
void primitive_bignum_multiply();
|
||||
void primitive_bignum_divint();
|
||||
void primitive_bignum_divmod();
|
||||
void primitive_bignum_mod();
|
||||
void primitive_bignum_and();
|
||||
void primitive_bignum_or();
|
||||
void primitive_bignum_xor();
|
||||
void primitive_bignum_shift();
|
||||
void primitive_bignum_less();
|
||||
void primitive_bignum_lesseq();
|
||||
void primitive_bignum_greater();
|
||||
void primitive_bignum_greatereq();
|
||||
void primitive_bignum_not();
|
||||
void primitive_bignum_bitp();
|
||||
void primitive_bignum_log2();
|
||||
unsigned int bignum_producer(unsigned int digit);
|
||||
inline void primitive_byte_array_to_bignum();
|
||||
void primitive_byte_array_to_bignum();
|
||||
cell unbox_array_size();
|
||||
inline void primitive_fixnum_to_float();
|
||||
inline void primitive_bignum_to_float();
|
||||
inline void primitive_str_to_float();
|
||||
inline void primitive_float_to_str();
|
||||
inline void primitive_float_eq();
|
||||
inline void primitive_float_add();
|
||||
inline void primitive_float_subtract();
|
||||
inline void primitive_float_multiply();
|
||||
inline void primitive_float_divfloat();
|
||||
inline void primitive_float_mod();
|
||||
inline void primitive_float_less();
|
||||
inline void primitive_float_lesseq();
|
||||
inline void primitive_float_greater();
|
||||
inline void primitive_float_greatereq();
|
||||
inline void primitive_float_bits();
|
||||
inline void primitive_bits_float();
|
||||
inline void primitive_double_bits();
|
||||
inline void primitive_bits_double();
|
||||
void primitive_fixnum_to_float();
|
||||
void primitive_bignum_to_float();
|
||||
void primitive_str_to_float();
|
||||
void primitive_float_to_str();
|
||||
void primitive_float_eq();
|
||||
void primitive_float_add();
|
||||
void primitive_float_subtract();
|
||||
void primitive_float_multiply();
|
||||
void primitive_float_divfloat();
|
||||
void primitive_float_mod();
|
||||
void primitive_float_less();
|
||||
void primitive_float_lesseq();
|
||||
void primitive_float_greater();
|
||||
void primitive_float_greatereq();
|
||||
void primitive_float_bits();
|
||||
void primitive_bits_float();
|
||||
void primitive_double_bits();
|
||||
void primitive_bits_double();
|
||||
fixnum to_fixnum(cell tagged);
|
||||
cell to_cell(cell tagged);
|
||||
void box_signed_1(s8 n);
|
||||
|
@ -366,16 +505,18 @@ struct factor_vm : factor_vm_data {
|
|||
//io
|
||||
void init_c_io();
|
||||
void io_error();
|
||||
inline void primitive_fopen();
|
||||
inline void primitive_fgetc();
|
||||
inline void primitive_fread();
|
||||
inline void primitive_fputc();
|
||||
inline void primitive_fwrite();
|
||||
inline void primitive_fseek();
|
||||
inline void primitive_fflush();
|
||||
inline void primitive_fclose();
|
||||
void primitive_fopen();
|
||||
void primitive_fgetc();
|
||||
void primitive_fread();
|
||||
void primitive_fputc();
|
||||
void primitive_fwrite();
|
||||
void primitive_fseek();
|
||||
void primitive_fflush();
|
||||
void primitive_fclose();
|
||||
|
||||
//code_block
|
||||
typedef void (factor_vm::*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled);
|
||||
|
||||
relocation_type relocation_type_of(relocation_entry r);
|
||||
relocation_class relocation_class_of(relocation_entry r);
|
||||
cell relocation_offset_of(relocation_entry r);
|
||||
|
@ -414,14 +555,18 @@ struct factor_vm : factor_vm_data {
|
|||
}
|
||||
|
||||
//code_heap
|
||||
heap *code;
|
||||
unordered_map<heap_block *, char *> forwarding;
|
||||
typedef void (factor_vm::*code_heap_iterator)(code_block *compiled);
|
||||
|
||||
void init_code_heap(cell size);
|
||||
bool in_code_heap_p(cell ptr);
|
||||
void jit_compile_word(cell word_, cell def_, bool relocate);
|
||||
void iterate_code_heap(code_heap_iterator iter);
|
||||
void copy_code_heap_roots();
|
||||
void update_code_heap_words();
|
||||
inline void primitive_modify_code_heap();
|
||||
inline void primitive_code_room();
|
||||
void primitive_modify_code_heap();
|
||||
void primitive_code_room();
|
||||
code_block *forward_xt(code_block *compiled);
|
||||
void forward_frame_xt(stack_frame *frame);
|
||||
void forward_object_xts();
|
||||
|
@ -430,12 +575,15 @@ struct factor_vm : factor_vm_data {
|
|||
inline void check_code_pointer(cell ptr);
|
||||
|
||||
//image
|
||||
cell code_relocation_base;
|
||||
cell data_relocation_base;
|
||||
|
||||
void init_objects(image_header *h);
|
||||
void load_data_heap(FILE *file, image_header *h, vm_parameters *p);
|
||||
void load_code_heap(FILE *file, image_header *h, vm_parameters *p);
|
||||
bool save_image(const vm_char *filename);
|
||||
inline void primitive_save_image();
|
||||
inline void primitive_save_image_and_exit();
|
||||
void primitive_save_image();
|
||||
void primitive_save_image_and_exit();
|
||||
void data_fixup(cell *cell);
|
||||
template <typename T> void code_fixup(T **handle);
|
||||
void fixup_word(word *word);
|
||||
|
@ -455,19 +603,19 @@ struct factor_vm : factor_vm_data {
|
|||
callstack *allot_callstack(cell size);
|
||||
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
|
||||
stack_frame *capture_start();
|
||||
inline void primitive_callstack();
|
||||
inline void primitive_set_callstack();
|
||||
void primitive_callstack();
|
||||
void primitive_set_callstack();
|
||||
code_block *frame_code(stack_frame *frame);
|
||||
cell frame_type(stack_frame *frame);
|
||||
cell frame_executing(stack_frame *frame);
|
||||
stack_frame *frame_successor(stack_frame *frame);
|
||||
cell frame_scan(stack_frame *frame);
|
||||
inline void primitive_callstack_to_array();
|
||||
void primitive_callstack_to_array();
|
||||
stack_frame *innermost_stack_frame(callstack *stack);
|
||||
stack_frame *innermost_stack_frame_quot(callstack *callstack);
|
||||
inline void primitive_innermost_stack_frame_executing();
|
||||
inline void primitive_innermost_stack_frame_scan();
|
||||
inline void primitive_set_innermost_stack_frame_quot();
|
||||
void primitive_innermost_stack_frame_executing();
|
||||
void primitive_innermost_stack_frame_scan();
|
||||
void primitive_set_innermost_stack_frame_quot();
|
||||
void save_callstack_bottom(stack_frame *callstack_bottom);
|
||||
template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator);
|
||||
inline void do_slots(cell obj, void (* iter)(cell *,factor_vm*));
|
||||
|
@ -475,14 +623,14 @@ struct factor_vm : factor_vm_data {
|
|||
//alien
|
||||
char *pinned_alien_offset(cell obj);
|
||||
cell allot_alien(cell delegate_, cell displacement);
|
||||
inline void primitive_displaced_alien();
|
||||
inline void primitive_alien_address();
|
||||
void primitive_displaced_alien();
|
||||
void primitive_alien_address();
|
||||
void *alien_pointer();
|
||||
inline void primitive_dlopen();
|
||||
inline void primitive_dlsym();
|
||||
inline void primitive_dlclose();
|
||||
inline void primitive_dll_validp();
|
||||
inline void primitive_vm_ptr();
|
||||
void primitive_dlopen();
|
||||
void primitive_dlsym();
|
||||
void primitive_dlclose();
|
||||
void primitive_dll_validp();
|
||||
void primitive_vm_ptr();
|
||||
char *alien_offset(cell obj);
|
||||
char *unbox_alien();
|
||||
void box_alien(void *ptr);
|
||||
|
@ -492,17 +640,20 @@ struct factor_vm : factor_vm_data {
|
|||
void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
|
||||
|
||||
//quotations
|
||||
inline void primitive_jit_compile();
|
||||
inline void primitive_array_to_quotation();
|
||||
inline void primitive_quotation_xt();
|
||||
void primitive_jit_compile();
|
||||
void primitive_array_to_quotation();
|
||||
void primitive_quotation_xt();
|
||||
void set_quot_xt(quotation *quot, code_block *code);
|
||||
void jit_compile(cell quot_, bool relocating);
|
||||
void compile_all_words();
|
||||
fixnum quot_code_offset_to_scan(cell quot_, cell offset);
|
||||
cell lazy_jit_compile_impl(cell quot_, stack_frame *stack);
|
||||
inline void primitive_quot_compiled_p();
|
||||
void primitive_quot_compiled_p();
|
||||
|
||||
//dispatch
|
||||
cell megamorphic_cache_hits;
|
||||
cell megamorphic_cache_misses;
|
||||
|
||||
cell search_lookup_alist(cell table, cell klass);
|
||||
cell search_lookup_hash(cell table, cell klass, cell hashcode);
|
||||
cell nth_superclass(tuple_layout *layout, fixnum echelon);
|
||||
|
@ -511,15 +662,21 @@ struct factor_vm : factor_vm_data {
|
|||
cell lookup_hi_tag_method(cell obj, cell methods);
|
||||
cell lookup_hairy_method(cell obj, cell methods);
|
||||
cell lookup_method(cell obj, cell methods);
|
||||
inline void primitive_lookup_method();
|
||||
void primitive_lookup_method();
|
||||
cell object_class(cell obj);
|
||||
cell method_cache_hashcode(cell klass, array *array);
|
||||
void update_method_cache(cell cache, cell klass, cell method);
|
||||
inline void primitive_mega_cache_miss();
|
||||
inline void primitive_reset_dispatch_stats();
|
||||
inline void primitive_dispatch_stats();
|
||||
void primitive_mega_cache_miss();
|
||||
void primitive_reset_dispatch_stats();
|
||||
void primitive_dispatch_stats();
|
||||
|
||||
//inline cache
|
||||
cell max_pic_size;
|
||||
cell cold_call_to_ic_transitions;
|
||||
cell ic_to_pic_transitions;
|
||||
cell pic_to_mega_transitions;
|
||||
cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
|
||||
|
||||
void init_inline_caching(int max_size);
|
||||
void deallocate_inline_cache(cell return_address);
|
||||
cell determine_inline_cache_type(array *cache_entries);
|
||||
|
@ -530,8 +687,8 @@ struct factor_vm : factor_vm_data {
|
|||
cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_);
|
||||
void update_pic_transitions(cell pic_size);
|
||||
void *inline_cache_miss(cell return_address);
|
||||
inline void primitive_reset_inline_cache_stats();
|
||||
inline void primitive_inline_cache_stats();
|
||||
void primitive_reset_inline_cache_stats();
|
||||
void primitive_inline_cache_stats();
|
||||
|
||||
//factor
|
||||
void default_parameters(vm_parameters *p);
|
||||
|
@ -549,7 +706,7 @@ struct factor_vm : factor_vm_data {
|
|||
void factor_sleep(long us);
|
||||
|
||||
// os-*
|
||||
inline void primitive_existsp();
|
||||
void primitive_existsp();
|
||||
void init_ffi();
|
||||
void ffi_dlopen(dll *dll);
|
||||
void *ffi_dlsym(dll *dll, symbol_char *symbol);
|
||||
|
@ -581,11 +738,25 @@ struct factor_vm : factor_vm_data {
|
|||
void call_fault_handler(exception_type_t exception, exception_data_type_t code, MACH_EXC_STATE_TYPE *exc_state, MACH_THREAD_STATE_TYPE *thread_state, MACH_FLOAT_STATE_TYPE *float_state);
|
||||
#endif
|
||||
|
||||
void print_vm_data();
|
||||
factor_vm()
|
||||
: profiling_p(false),
|
||||
secure_gc(false),
|
||||
gc_off(false),
|
||||
performing_gc(false),
|
||||
performing_compaction(false),
|
||||
collecting_aging_again(false),
|
||||
growing_data_heap(false),
|
||||
fep_disabled(false),
|
||||
full_output(false),
|
||||
max_pic_size(0)
|
||||
{
|
||||
memset(this,0,sizeof(this)); // just to make sure
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
#ifndef FACTOR_REENTRANT
|
||||
#define FACTOR_SINGLE_THREADED_SINGLETON
|
||||
#define FACTOR_SINGLE_THREADED_TESTING
|
||||
#endif
|
||||
|
||||
#ifdef FACTOR_SINGLE_THREADED_SINGLETON
|
||||
|
|
16
vm/words.cpp
16
vm/words.cpp
|
@ -32,7 +32,7 @@ word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_)
|
|||
}
|
||||
|
||||
/* (word) ( name vocabulary hashcode -- word ) */
|
||||
inline void factor_vm::primitive_word()
|
||||
void factor_vm::primitive_word()
|
||||
{
|
||||
cell hashcode = dpop();
|
||||
cell vocab = dpop();
|
||||
|
@ -40,10 +40,8 @@ inline void factor_vm::primitive_word()
|
|||
dpush(tag<word>(allot_word(name,vocab,hashcode)));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(word)
|
||||
|
||||
/* word-xt ( word -- start end ) */
|
||||
inline void factor_vm::primitive_word_xt()
|
||||
void factor_vm::primitive_word_xt()
|
||||
{
|
||||
gc_root<word> w(dpop(),this);
|
||||
w.untag_check(this);
|
||||
|
@ -60,8 +58,6 @@ inline void factor_vm::primitive_word_xt()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(word_xt)
|
||||
|
||||
/* Allocates memory */
|
||||
void factor_vm::update_word_xt(cell w_)
|
||||
{
|
||||
|
@ -84,20 +80,16 @@ void factor_vm::update_word_xt(cell w_)
|
|||
w->xt = w->code->xt();
|
||||
}
|
||||
|
||||
inline void factor_vm::primitive_optimized_p()
|
||||
void factor_vm::primitive_optimized_p()
|
||||
{
|
||||
drepl(tag_boolean(word_optimized_p(untag_check<word>(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(optimized_p)
|
||||
|
||||
inline void factor_vm::primitive_wrapper()
|
||||
void factor_vm::primitive_wrapper()
|
||||
{
|
||||
wrapper *new_wrapper = allot<wrapper>(sizeof(wrapper));
|
||||
new_wrapper->object = dpeek();
|
||||
drepl(tag<wrapper>(new_wrapper));
|
||||
}
|
||||
|
||||
PRIMITIVE_FORWARD(wrapper)
|
||||
|
||||
}
|
||||
|
|
|
@ -1,15 +1,9 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
PRIMITIVE(word);
|
||||
PRIMITIVE(word_xt);
|
||||
|
||||
inline bool word_optimized_p(word *word)
|
||||
{
|
||||
return word->code->type == WORD_TYPE;
|
||||
}
|
||||
|
||||
PRIMITIVE(optimized_p);
|
||||
PRIMITIVE(wrapper);
|
||||
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue