/* gets the address of an object representing a C pointer, with the
intention of storing the pointer across code which may potentially GC. */
-char *pinned_alien_offset(cell obj)
+char *factorvm::pinned_alien_offset(cell obj)
{
switch(tagged<object>(obj).type())
{
}
}
+char *pinned_alien_offset(cell obj)
+{
+ return vm->pinned_alien_offset(obj);
+}
+
/* make an alien */
-cell allot_alien(cell delegate_, cell displacement)
+cell factorvm::allot_alien(cell delegate_, cell displacement)
{
gc_root<object> delegate(delegate_);
gc_root<alien> new_alien(allot<alien>(sizeof(alien)));
return new_alien.value();
}
+cell allot_alien(cell delegate_, cell displacement)
+{
+ return vm->allot_alien(delegate_,displacement);
+}
+
/* make an alien pointing at an offset of another alien */
-PRIMITIVE(displaced_alien)
+inline void factorvm::vmprim_displaced_alien()
{
cell alien = dpop();
cell displacement = to_cell(dpop());
}
}
+PRIMITIVE(displaced_alien)
+{
+ PRIMITIVE_GETVM()->vmprim_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. */
-PRIMITIVE(alien_address)
+inline void factorvm::vmprim_alien_address()
{
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
}
+PRIMITIVE(alien_address)
+{
+ PRIMITIVE_GETVM()->vmprim_alien_address();
+}
+
/* pop ( alien n ) from datastack, return alien's address plus n */
-static void *alien_pointer()
+void *factorvm::alien_pointer()
{
fixnum offset = to_fixnum(dpop());
return unbox_alien() + offset;
}
+void *alien_pointer()
+{
+ return vm->alien_pointer();
+}
+
/* define words to read/write values at an alien address */
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
PRIMITIVE(alien_##name) \
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
/* open a native library and push a handle */
-PRIMITIVE(dlopen)
+inline void factorvm::vmprim_dlopen()
{
gc_root<byte_array> path(dpop());
path.untag_check();
dpush(library.value());
}
+PRIMITIVE(dlopen)
+{
+ PRIMITIVE_GETVM()->vmprim_dlopen();
+}
+
/* look up a symbol in a native library */
-PRIMITIVE(dlsym)
+inline void factorvm::vmprim_dlsym()
{
gc_root<object> library(dpop());
gc_root<byte_array> name(dpop());
}
}
+PRIMITIVE(dlsym)
+{
+ PRIMITIVE_GETVM()->vmprim_dlsym();
+}
+
/* close a native library handle */
-PRIMITIVE(dlclose)
+inline void factorvm::vmprim_dlclose()
{
dll *d = untag_check<dll>(dpop());
if(d->dll != NULL)
ffi_dlclose(d);
}
-PRIMITIVE(dll_validp)
+PRIMITIVE(dlclose)
+{
+ PRIMITIVE_GETVM()->vmprim_dlclose();
+}
+
+inline void factorvm::vmprim_dll_validp()
{
cell library = dpop();
if(library == F)
dpush(untag_check<dll>(library)->dll == NULL ? F : T);
}
+PRIMITIVE(dll_validp)
+{
+ PRIMITIVE_GETVM()->vmprim_dll_validp();
+}
+
/* gets the address of an object representing a C pointer */
-VM_C_API char *alien_offset(cell obj)
+char *factorvm::alien_offset(cell obj)
{
switch(tagged<object>(obj).type())
{
}
}
+VM_C_API char *alien_offset(cell obj)
+{
+ return vm->alien_offset(obj);
+}
+
/* pop an object representing a C pointer */
-VM_C_API char *unbox_alien()
+char *factorvm::unbox_alien()
{
return alien_offset(dpop());
}
+VM_C_API char *unbox_alien()
+{
+ return vm->unbox_alien();
+}
+
/* make an alien and push */
-VM_C_API void box_alien(void *ptr)
+void factorvm::box_alien(void *ptr)
{
if(ptr == NULL)
dpush(F);
dpush(allot_alien(F,(cell)ptr));
}
+VM_C_API void box_alien(void *ptr)
+{
+ return vm->box_alien(ptr);
+}
+
/* for FFI calls passing structs by value */
-VM_C_API void to_value_struct(cell src, void *dest, cell size)
+void factorvm::to_value_struct(cell src, void *dest, cell size)
{
memcpy(dest,alien_offset(src),size);
}
+VM_C_API void to_value_struct(cell src, void *dest, cell size)
+{
+ return vm->to_value_struct(src,dest,size);
+}
+
/* for FFI callbacks receiving structs by value */
-VM_C_API void box_value_struct(void *src, cell size)
+void factorvm::box_value_struct(void *src, cell size)
{
byte_array *bytes = allot_byte_array(size);
memcpy(bytes->data<void>(),src,size);
dpush(tag<byte_array>(bytes));
}
+VM_C_API void box_value_struct(void *src, cell size)
+{
+ return vm->box_value_struct(src,size);
+}
+
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
-VM_C_API void box_small_struct(cell x, cell y, cell size)
+void factorvm::box_small_struct(cell x, cell y, cell size)
{
cell data[2];
data[0] = x;
box_value_struct(data,size);
}
+VM_C_API void box_small_struct(cell x, cell y, cell size)
+{
+ return vm->box_small_struct(x,y,size);
+}
+
/* On OS X/PPC, complex numbers are returned in registers. */
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
+void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
{
cell data[4];
data[0] = x1;
box_value_struct(data,size);
}
+VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
+{
+ return vm->box_medium_struct(x1, x2, x3, x4, size);
+}
+
}
namespace factor
{
-static void check_frame(stack_frame *frame)
+void factorvm::check_frame(stack_frame *frame)
{
#ifdef FACTOR_DEBUG
check_code_pointer((cell)frame->xt);
#endif
}
-callstack *allot_callstack(cell size)
+void check_frame(stack_frame *frame)
+{
+ return vm->check_frame(frame);
+}
+
+callstack *factorvm::allot_callstack(cell size)
{
callstack *stack = allot<callstack>(callstack_size(size));
stack->length = tag_fixnum(size);
return stack;
}
-stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
+callstack *allot_callstack(cell size)
+{
+ return vm->allot_callstack(size);
+}
+
+stack_frame *factorvm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
{
stack_frame *frame = bottom - 1;
return frame + 1;
}
+stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
+{
+ return vm->fix_callstack_top(top,bottom);
+}
+
/* We ignore the topmost frame, the one calling 'callstack',
so that set-callstack doesn't get stuck in an infinite loop.
will have popped a necessary frame... however this word is only
called by continuation implementation, and user code shouldn't
be calling it at all, so we leave it as it is for now. */
-stack_frame *capture_start()
+stack_frame *factorvm::capture_start()
{
stack_frame *frame = stack_chain->callstack_bottom - 1;
while(frame >= stack_chain->callstack_top
return frame + 1;
}
-PRIMITIVE(callstack)
+stack_frame *capture_start()
+{
+ return vm->capture_start();
+}
+
+inline void factorvm::vmprim_callstack()
{
stack_frame *top = capture_start();
stack_frame *bottom = stack_chain->callstack_bottom;
dpush(tag<callstack>(stack));
}
-PRIMITIVE(set_callstack)
+PRIMITIVE(callstack)
+{
+ PRIMITIVE_GETVM()->vmprim_callstack();
+}
+
+inline void factorvm::vmprim_set_callstack()
{
callstack *stack = untag_check<callstack>(dpop());
critical_error("Bug in set_callstack()",0);
}
-code_block *frame_code(stack_frame *frame)
+PRIMITIVE(set_callstack)
+{
+ PRIMITIVE_GETVM()->vmprim_set_callstack();
+}
+
+code_block *factorvm::frame_code(stack_frame *frame)
{
check_frame(frame);
return (code_block *)frame->xt - 1;
}
-cell frame_type(stack_frame *frame)
+code_block *frame_code(stack_frame *frame)
+{
+ return vm->frame_code(frame);
+}
+
+cell factorvm::frame_type(stack_frame *frame)
{
return frame_code(frame)->type;
}
-cell frame_executing(stack_frame *frame)
+cell frame_type(stack_frame *frame)
+{
+ return vm->frame_type(frame);
+}
+
+cell factorvm::frame_executing(stack_frame *frame)
{
code_block *compiled = frame_code(frame);
if(compiled->literals == F || !stack_traces_p())
}
}
-stack_frame *frame_successor(stack_frame *frame)
+cell frame_executing(stack_frame *frame)
+{
+ return vm->frame_executing(frame);
+}
+
+stack_frame *factorvm::frame_successor(stack_frame *frame)
{
check_frame(frame);
return (stack_frame *)((cell)frame - frame->size);
}
+stack_frame *frame_successor(stack_frame *frame)
+{
+ return vm->frame_successor(frame);
+}
+
/* Allocates memory */
-cell frame_scan(stack_frame *frame)
+cell factorvm::frame_scan(stack_frame *frame)
{
switch(frame_type(frame))
{
}
}
+cell frame_scan(stack_frame *frame)
+{
+ return vm->frame_scan(frame);
+}
+
namespace
{
}
-PRIMITIVE(callstack_to_array)
+inline void factorvm::vmprim_callstack_to_array()
{
gc_root<callstack> callstack(dpop());
dpush(accum.frames.elements.value());
}
-stack_frame *innermost_stack_frame(callstack *stack)
+PRIMITIVE(callstack_to_array)
+{
+ PRIMITIVE_GETVM()->vmprim_callstack_to_array();
+}
+
+stack_frame *factorvm::innermost_stack_frame(callstack *stack)
{
stack_frame *top = stack->top();
stack_frame *bottom = stack->bottom();
return frame;
}
-stack_frame *innermost_stack_frame_quot(callstack *callstack)
+stack_frame *innermost_stack_frame(callstack *stack)
+{
+ return vm->innermost_stack_frame(stack);
+}
+
+stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
{
stack_frame *inner = innermost_stack_frame(callstack);
tagged<quotation>(frame_executing(inner)).untag_check();
return inner;
}
+stack_frame *innermost_stack_frame_quot(callstack *callstack)
+{
+ return vm->innermost_stack_frame_quot(callstack);
+}
+
/* Some primitives implementing a limited form of callstack mutation.
Used by the single stepper. */
-PRIMITIVE(innermost_stack_frame_executing)
+inline void factorvm::vmprim_innermost_stack_frame_executing()
{
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
}
-PRIMITIVE(innermost_stack_frame_scan)
+PRIMITIVE(innermost_stack_frame_executing)
+{
+ PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_executing();
+}
+
+inline void factorvm::vmprim_innermost_stack_frame_scan()
{
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
}
-PRIMITIVE(set_innermost_stack_frame_quot)
+PRIMITIVE(innermost_stack_frame_scan)
+{
+ PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_scan();
+}
+
+inline void factorvm::vmprim_set_innermost_stack_frame_quot()
{
gc_root<callstack> callstack(dpop());
gc_root<quotation> quot(dpop());
FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
}
+PRIMITIVE(set_innermost_stack_frame_quot)
+{
+ PRIMITIVE_GETVM()->vmprim_set_innermost_stack_frame_quot();
+}
+
/* called before entry into Factor code. */
-VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
+void factorvm::save_callstack_bottom(stack_frame *callstack_bottom)
{
stack_chain->callstack_bottom = callstack_bottom;
}
+VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
+{
+ return vm->save_callstack_bottom(callstack_bottom);
+}
+
}
code_heap_scans++;
if(collecting_gen == data->tenured())
- free_unmarked(&code,(heap_iterator)update_literal_and_word_references);
+ free_unmarked(&code,(heap_iterator)factor::update_literal_and_word_references);
else
copy_code_heap_roots();
}
/* Update XTs in code heap */
- iterate_code_heap(relocate_code_block);
+ iterate_code_heap(factor::relocate_code_block);
}
void set_profiling(bool profiling)
void fixup_code_block(code_block *compiled);
void relocate_code();
void load_image(vm_parameters *p);
+
+ //callstack
+ void check_frame(stack_frame *frame);
+ callstack *allot_callstack(cell size);
+ stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
+ stack_frame *capture_start();
+ inline void vmprim_callstack();
+ inline void vmprim_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 vmprim_callstack_to_array();
+ stack_frame *innermost_stack_frame(callstack *stack);
+ stack_frame *innermost_stack_frame_quot(callstack *callstack);
+ inline void vmprim_innermost_stack_frame_executing();
+ inline void vmprim_innermost_stack_frame_scan();
+ inline void vmprim_set_innermost_stack_frame_quot();
+ void save_callstack_bottom(stack_frame *callstack_bottom);
+
+ //alien
+ char *pinned_alien_offset(cell obj);
+ cell allot_alien(cell delegate_, cell displacement);
+ inline void vmprim_displaced_alien();
+ inline void vmprim_alien_address();
+ void *alien_pointer();
+ inline void vmprim_dlopen();
+ inline void vmprim_dlsym();
+ inline void vmprim_dlclose();
+ inline void vmprim_dll_validp();
+ char *alien_offset(cell obj);
+ char *unbox_alien();
+ void box_alien(void *ptr);
+ void to_value_struct(cell src, void *dest, cell size);
+ void box_value_struct(void *src, cell size);
+ void box_small_struct(cell x, cell y, cell size);
+ void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
// next method here: