steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

vm: eliminating register variables work in progress. Works on x86-32 with non-optimizing compiler

db4
Slava Pestov 2009-12-19 10:59:56 +13:00
parent dbbcf74cda
commit 63edd20a55
42 changed files with 569 additions and 607 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
basis/cpu/x86/32/bootstrap.factor
View File

@ -34,18 +34,37 @@ IN: bootstrap.x86
ESP stack-frame-size 3 bootstrap-cells - SUB ESP stack-frame-size 3 bootstrap-cells - SUB
] jit-prolog jit-define ] jit-prolog jit-define
: jit-load-vm ( -- )
EBP 0 MOV 0 rc-absolute-cell jit-vm ;
: jit-save-context ( -- ) : jit-save-context ( -- )
EAX 0 [] MOV rc-absolute-cell rt-context jit-rel ! VM pointer must be in EBP already
! save stack pointer ECX EBP [] MOV
ECX ESP -4 [+] LEA ! save ctx->callstack_top
EAX [] ECX MOV ; EAX ESP -4 [+] LEA
ECX [] EAX MOV
! save ctx->datastack
ECX 8 [+] ds-reg MOV
! save ctx->retainstack
ECX 12 [+] rs-reg MOV ;
: jit-restore-context ( -- )
! VM pointer must be in EBP already
ECX EBP [] MOV
! restore ctx->datastack
ds-reg ECX 8 [+] MOV
! restore ctx->retainstack
rs-reg ECX 12 [+] MOV ;
[ [
jit-load-vm
! save ds, rs registers
jit-save-context jit-save-context
! pass vm ptr to primitive
EAX 0 MOV rc-absolute-cell rt-vm jit-rel
! call the primitive ! call the primitive
ESP [] EBP MOV
0 CALL rc-relative rt-primitive jit-rel 0 CALL rc-relative rt-primitive jit-rel
! restore ds, rs registers
jit-restore-context
] jit-primitive jit-define ] jit-primitive jit-define
! Inline cache miss entry points ! Inline cache miss entry points
@ -55,10 +74,12 @@ IN: bootstrap.x86
! These are always in tail position with an existing stack ! These are always in tail position with an existing stack
! frame, and the stack. The frame setup takes this into account. ! frame, and the stack. The frame setup takes this into account.
: jit-inline-cache-miss ( -- ) : jit-inline-cache-miss ( -- )
jit-load-vm
jit-save-context jit-save-context
ESP 4 [+] 0 MOV 0 rc-absolute-cell jit-vm ESP 4 [+] EBP MOV
ESP [] EBX MOV ESP [] EBX MOV
0 CALL "inline_cache_miss" f rc-relative jit-dlsym ; 0 CALL "inline_cache_miss" f rc-relative jit-dlsym
jit-restore-context ;
[ jit-load-return-address jit-inline-cache-miss ] [ jit-load-return-address jit-inline-cache-miss ]
[ EAX CALL ] [ EAX CALL ]
@ -72,16 +93,17 @@ IN: bootstrap.x86
! Overflowing fixnum arithmetic ! Overflowing fixnum arithmetic
: jit-overflow ( insn func -- ) : jit-overflow ( insn func -- )
jit-save-context
EAX ds-reg -4 [+] MOV
EDX ds-reg [] MOV
ds-reg 4 SUB ds-reg 4 SUB
jit-load-vm
jit-save-context
EAX ds-reg [] MOV
EDX ds-reg 4 [+] MOV
ECX EAX MOV ECX EAX MOV
[ [ ECX EDX ] dip call( dst src -- ) ] dip [ [ ECX EDX ] dip call( dst src -- ) ] dip
ds-reg [] ECX MOV ds-reg [] ECX MOV
[ JNO ] [ JNO ]
[ [
ECX 0 MOV 0 rc-absolute-cell jit-vm ECX EBP MOV
[ 0 CALL ] dip f rc-relative jit-dlsym [ 0 CALL ] dip f rc-relative jit-dlsym
] ]
jit-conditional ; jit-conditional ;
@ -91,12 +113,13 @@ IN: bootstrap.x86
[ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
[ [
jit-save-context
ECX ds-reg -4 [+] MOV
EBX ds-reg [] MOV
EBX tag-bits get SAR
ds-reg 4 SUB ds-reg 4 SUB
jit-load-vm
jit-save-context
ECX ds-reg [] MOV
EAX ECX MOV EAX ECX MOV
EBX ds-reg 4 [+] MOV
EBX tag-bits get SAR
EBX IMUL EBX IMUL
ds-reg [] EAX MOV ds-reg [] EAX MOV
[ JNO ] [ JNO ]
@ -104,7 +127,7 @@ IN: bootstrap.x86
EAX ECX MOV EAX ECX MOV
EAX tag-bits get SAR EAX tag-bits get SAR
EDX EBX MOV EDX EBX MOV
ECX 0 MOV 0 rc-absolute-cell jit-vm ECX EBP MOV
0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym 0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym
] ]
jit-conditional jit-conditional

122
vm/alien.cpp
View File

@ -27,9 +27,17 @@ char *factor_vm::pinned_alien_offset(cell obj)
} }
} }
VM_C_API char *pinned_alien_offset(cell obj, factor_vm *parent)
{
return parent->pinned_alien_offset(obj);
}
/* make an alien */ /* make an alien */
cell factor_vm::allot_alien(cell delegate_, cell displacement) cell factor_vm::allot_alien(cell delegate_, cell displacement)
{ {
if(delegate_ == false_object && displacement == 0)
return false_object;
data_root<object> delegate(delegate_,this); data_root<object> delegate(delegate_,this);
data_root<alien> new_alien(allot<alien>(sizeof(alien)),this); data_root<alien> new_alien(allot<alien>(sizeof(alien)),this);
@ -49,87 +57,92 @@ cell factor_vm::allot_alien(cell delegate_, cell displacement)
return new_alien.value(); return new_alien.value();
} }
cell factor_vm::allot_alien(void *address)
{
return allot_alien(false_object,(cell)address);
}
VM_C_API cell allot_alien(void *address, factor_vm *vm)
{
return vm->allot_alien(address);
}
/* make an alien pointing at an offset of another alien */ /* make an alien pointing at an offset of another alien */
void factor_vm::primitive_displaced_alien() void factor_vm::primitive_displaced_alien()
{ {
cell alien = dpop(); cell alien = ctx->pop();
cell displacement = to_cell(dpop()); cell displacement = to_cell(ctx->pop());
if(!to_boolean(alien) && displacement == 0)
dpush(false_object);
else
{
switch(tagged<object>(alien).type()) switch(tagged<object>(alien).type())
{ {
case BYTE_ARRAY_TYPE: case BYTE_ARRAY_TYPE:
case ALIEN_TYPE: case ALIEN_TYPE:
case F_TYPE: case F_TYPE:
dpush(allot_alien(alien,displacement)); ctx->push(allot_alien(alien,displacement));
break; break;
default: default:
type_error(ALIEN_TYPE,alien); type_error(ALIEN_TYPE,alien);
break; break;
} }
}
} }
/* address of an object representing a C pointer. Explicitly throw an error /* address of an object representing a C pointer. Explicitly throw an error
if the object is a byte array, as a sanity check. */ if the object is a byte array, as a sanity check. */
void factor_vm::primitive_alien_address() void factor_vm::primitive_alien_address()
{ {
box_unsigned_cell((cell)pinned_alien_offset(dpop())); ctx->push(allot_cell((cell)pinned_alien_offset(ctx->pop())));
} }
/* pop ( alien n ) from datastack, return alien's address plus n */ /* pop ( alien n ) from datastack, return alien's address plus n */
void *factor_vm::alien_pointer() void *factor_vm::alien_pointer()
{ {
fixnum offset = to_fixnum(dpop()); fixnum offset = to_fixnum(ctx->pop());
return unbox_alien() + offset; return alien_offset(ctx->pop()) + offset;
} }
/* define words to read/write values at an alien address */ /* define words to read/write values at an alien address */
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \ #define DEFINE_ALIEN_ACCESSOR(name,type,from,to) \
PRIMITIVE(alien_##name) \ PRIMITIVE(alien_##name) \
{ \ { \
parent->boxer(*(type*)(parent->alien_pointer())); \ parent->ctx->push(from(*(type*)(parent->alien_pointer()),parent)); \
} \ } \
PRIMITIVE(set_alien_##name) \ PRIMITIVE(set_alien_##name) \
{ \ { \
type *ptr = (type *)parent->alien_pointer(); \ type *ptr = (type *)parent->alien_pointer(); \
type value = parent->to(dpop()); \ type value = to(parent->ctx->pop(),parent); \
*ptr = value; \ *ptr = value; \
} }
DEFINE_ALIEN_ACCESSOR(signed_cell,fixnum,box_signed_cell,to_fixnum) DEFINE_ALIEN_ACCESSOR(signed_cell,fixnum,from_signed_cell,to_fixnum)
DEFINE_ALIEN_ACCESSOR(unsigned_cell,cell,box_unsigned_cell,to_cell) DEFINE_ALIEN_ACCESSOR(unsigned_cell,cell,from_unsigned_cell,to_cell)
DEFINE_ALIEN_ACCESSOR(signed_8,s64,box_signed_8,to_signed_8) DEFINE_ALIEN_ACCESSOR(signed_8,s64,from_signed_8,to_signed_8)
DEFINE_ALIEN_ACCESSOR(unsigned_8,u64,box_unsigned_8,to_unsigned_8) DEFINE_ALIEN_ACCESSOR(unsigned_8,u64,from_unsigned_8,to_unsigned_8)
DEFINE_ALIEN_ACCESSOR(signed_4,s32,box_signed_4,to_fixnum) DEFINE_ALIEN_ACCESSOR(signed_4,s32,from_signed_4,to_fixnum)
DEFINE_ALIEN_ACCESSOR(unsigned_4,u32,box_unsigned_4,to_cell) DEFINE_ALIEN_ACCESSOR(unsigned_4,u32,from_unsigned_4,to_cell)
DEFINE_ALIEN_ACCESSOR(signed_2,s16,box_signed_2,to_fixnum) DEFINE_ALIEN_ACCESSOR(signed_2,s16,from_signed_2,to_fixnum)
DEFINE_ALIEN_ACCESSOR(unsigned_2,u16,box_unsigned_2,to_cell) DEFINE_ALIEN_ACCESSOR(unsigned_2,u16,from_unsigned_2,to_cell)
DEFINE_ALIEN_ACCESSOR(signed_1,s8,box_signed_1,to_fixnum) DEFINE_ALIEN_ACCESSOR(signed_1,s8,from_signed_1,to_fixnum)
DEFINE_ALIEN_ACCESSOR(unsigned_1,u8,box_unsigned_1,to_cell) DEFINE_ALIEN_ACCESSOR(unsigned_1,u8,from_unsigned_1,to_cell)
DEFINE_ALIEN_ACCESSOR(float,float,box_float,to_float) DEFINE_ALIEN_ACCESSOR(float,float,from_float,to_float)
DEFINE_ALIEN_ACCESSOR(double,double,box_double,to_double) DEFINE_ALIEN_ACCESSOR(double,double,from_double,to_double)
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset) DEFINE_ALIEN_ACCESSOR(cell,void *,allot_alien,pinned_alien_offset)
/* open a native library and push a handle */ /* open a native library and push a handle */
void factor_vm::primitive_dlopen() void factor_vm::primitive_dlopen()
{ {
data_root<byte_array> path(dpop(),this); data_root<byte_array> path(ctx->pop(),this);
path.untag_check(this); path.untag_check(this);
data_root<dll> library(allot<dll>(sizeof(dll)),this); data_root<dll> library(allot<dll>(sizeof(dll)),this);
library->path = path.value(); library->path = path.value();
ffi_dlopen(library.untagged()); ffi_dlopen(library.untagged());
dpush(library.value()); ctx->push(library.value());
} }
/* look up a symbol in a native library */ /* look up a symbol in a native library */
void factor_vm::primitive_dlsym() void factor_vm::primitive_dlsym()
{ {
data_root<object> library(dpop(),this); data_root<object> library(ctx->pop(),this);
data_root<byte_array> name(dpop(),this); data_root<byte_array> name(ctx->pop(),this);
name.untag_check(this); name.untag_check(this);
symbol_char *sym = name->data<symbol_char>(); symbol_char *sym = name->data<symbol_char>();
@ -139,29 +152,29 @@ void factor_vm::primitive_dlsym()
dll *d = untag_check<dll>(library.value()); dll *d = untag_check<dll>(library.value());
if(d->dll == NULL) if(d->dll == NULL)
dpush(false_object); ctx->push(false_object);
else else
box_alien(ffi_dlsym(d,sym)); ctx->push(allot_alien(ffi_dlsym(d,sym)));
} }
else else
box_alien(ffi_dlsym(NULL,sym)); ctx->push(allot_alien(ffi_dlsym(NULL,sym)));
} }
/* close a native library handle */ /* close a native library handle */
void factor_vm::primitive_dlclose() void factor_vm::primitive_dlclose()
{ {
dll *d = untag_check<dll>(dpop()); dll *d = untag_check<dll>(ctx->pop());
if(d->dll != NULL) if(d->dll != NULL)
ffi_dlclose(d); ffi_dlclose(d);
} }
void factor_vm::primitive_dll_validp() void factor_vm::primitive_dll_validp()
{ {
cell library = dpop(); cell library = ctx->pop();
if(to_boolean(library)) if(to_boolean(library))
dpush(tag_boolean(untag_check<dll>(library)->dll != NULL)); ctx->push(tag_boolean(untag_check<dll>(library)->dll != NULL));
else else
dpush(true_object); ctx->push(true_object);
} }
/* gets the address of an object representing a C pointer */ /* gets the address of an object representing a C pointer */
@ -186,32 +199,7 @@ VM_C_API char *alien_offset(cell obj, factor_vm *parent)
return parent->alien_offset(obj); return parent->alien_offset(obj);
} }
/* pop an object representing a C pointer */ /* For FFI calls passing structs by value. Cannot allocate */
char *factor_vm::unbox_alien()
{
return alien_offset(dpop());
}
VM_C_API char *unbox_alien(factor_vm *parent)
{
return parent->unbox_alien();
}
/* make an alien and push */
void factor_vm::box_alien(void *ptr)
{
if(ptr == NULL)
dpush(false_object);
else
dpush(allot_alien(false_object,(cell)ptr));
}
VM_C_API void box_alien(void *ptr, factor_vm *parent)
{
return parent->box_alien(ptr);
}
/* for FFI calls passing structs by value */
void factor_vm::to_value_struct(cell src, void *dest, cell size) void factor_vm::to_value_struct(cell src, void *dest, cell size)
{ {
memcpy(dest,alien_offset(src),size); memcpy(dest,alien_offset(src),size);
@ -222,12 +210,12 @@ VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *parent
return parent->to_value_struct(src,dest,size); return parent->to_value_struct(src,dest,size);
} }
/* for FFI callbacks receiving structs by value */ /* For FFI callbacks receiving structs by value */
void factor_vm::box_value_struct(void *src, cell size) void factor_vm::box_value_struct(void *src, cell size)
{ {
byte_array *bytes = allot_byte_array(size); byte_array *bytes = allot_byte_array(size);
memcpy(bytes->data<void>(),src,size); memcpy(bytes->data<void>(),src,size);
dpush(tag<byte_array>(bytes)); ctx->push(tag<byte_array>(bytes));
} }
VM_C_API void box_value_struct(void *src, cell size,factor_vm *parent) VM_C_API void box_value_struct(void *src, cell size,factor_vm *parent)
@ -267,7 +255,7 @@ VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, f
void factor_vm::primitive_vm_ptr() void factor_vm::primitive_vm_ptr()
{ {
box_alien(this); ctx->push(allot_alien(this));
} }
} }

4
vm/alien.hpp
View File

@ -2,8 +2,8 @@ namespace factor
{ {
VM_C_API char *alien_offset(cell object, factor_vm *vm); VM_C_API char *alien_offset(cell object, factor_vm *vm);
VM_C_API char *unbox_alien(factor_vm *vm); VM_C_API char *pinned_alien_offset(cell object, factor_vm *vm);
VM_C_API void box_alien(void *ptr, factor_vm *vm); VM_C_API cell allot_alien(void *address, factor_vm *vm);
VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *vm); VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *vm);
VM_C_API void box_value_struct(void *src, cell size,factor_vm *vm); VM_C_API void box_value_struct(void *src, cell size,factor_vm *vm);
VM_C_API void box_small_struct(cell x, cell y, cell size,factor_vm *vm); VM_C_API void box_small_struct(cell x, cell y, cell size,factor_vm *vm);

8
vm/arrays.cpp
View File

@ -13,11 +13,11 @@ array *factor_vm::allot_array(cell capacity, cell fill_)
void factor_vm::primitive_array() void factor_vm::primitive_array()
{ {
data_root<object> fill(dpop(),this); data_root<object> fill(ctx->pop(),this);
cell capacity = unbox_array_size(); cell capacity = unbox_array_size();
array *new_array = allot_uninitialized_array<array>(capacity); array *new_array = allot_uninitialized_array<array>(capacity);
memset_cell(new_array->data(),fill.value(),capacity * sizeof(cell)); memset_cell(new_array->data(),fill.value(),capacity * sizeof(cell));
dpush(tag<array>(new_array)); ctx->push(tag<array>(new_array));
} }
cell factor_vm::allot_array_1(cell obj_) cell factor_vm::allot_array_1(cell obj_)
@ -54,10 +54,10 @@ cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
void factor_vm::primitive_resize_array() void factor_vm::primitive_resize_array()
{ {
data_root<array> a(dpop(),this); data_root<array> a(ctx->pop(),this);
a.untag_check(this); a.untag_check(this);
cell capacity = unbox_array_size(); cell capacity = unbox_array_size();
dpush(tag<array>(reallot_array(a.untagged(),capacity))); ctx->push(tag<array>(reallot_array(a.untagged(),capacity)));
} }
void growable_array::add(cell elt_) void growable_array::add(cell elt_)

4
vm/bignum.cpp
View File

@ -329,6 +329,7 @@ bignum *factor_vm::bignum_remainder(bignum * numerator, bignum * denominator)
} }
} }
/* allocates memory */
#define FOO_TO_BIGNUM(name,type,utype) \ #define FOO_TO_BIGNUM(name,type,utype) \
bignum * factor_vm::name##_to_bignum(type n) \ bignum * factor_vm::name##_to_bignum(type n) \
{ \ { \
@ -359,12 +360,12 @@ bignum * factor_vm::name##_to_bignum(type n) \
} \ } \
} }
/* all below allocate memory */
FOO_TO_BIGNUM(cell,cell,cell) FOO_TO_BIGNUM(cell,cell,cell)
FOO_TO_BIGNUM(fixnum,fixnum,cell) FOO_TO_BIGNUM(fixnum,fixnum,cell)
FOO_TO_BIGNUM(long_long,s64,u64) FOO_TO_BIGNUM(long_long,s64,u64)
FOO_TO_BIGNUM(ulong_long,u64,u64) FOO_TO_BIGNUM(ulong_long,u64,u64)
/* cannot allocate memory */
#define BIGNUM_TO_FOO(name,type,utype) \ #define BIGNUM_TO_FOO(name,type,utype) \
type factor_vm::bignum_to_##name(bignum * bignum) \ type factor_vm::bignum_to_##name(bignum * bignum) \
{ \ { \
@ -380,7 +381,6 @@ FOO_TO_BIGNUM(ulong_long,u64,u64)
} \ } \
} }
/* all of the below allocate memory */
BIGNUM_TO_FOO(cell,cell,cell); BIGNUM_TO_FOO(cell,cell,cell);
BIGNUM_TO_FOO(fixnum,fixnum,cell); BIGNUM_TO_FOO(fixnum,fixnum,cell);
BIGNUM_TO_FOO(long_long,s64,u64) BIGNUM_TO_FOO(long_long,s64,u64)

15
vm/booleans.cpp
View File

@ -3,19 +3,14 @@
namespace factor namespace factor
{ {
void factor_vm::box_boolean(bool value)
{
dpush(tag_boolean(value));
}
VM_C_API void box_boolean(bool value, factor_vm *parent)
{
return parent->box_boolean(value);
}
VM_C_API bool to_boolean(cell value, factor_vm *parent) VM_C_API bool to_boolean(cell value, factor_vm *parent)
{ {
return to_boolean(value); return to_boolean(value);
} }
VM_C_API cell from_boolean(bool value, factor_vm *parent)
{
return parent->tag_boolean(value);
}
} }

3
vm/booleans.hpp
View File

@ -1,9 +1,10 @@
namespace factor namespace factor
{ {
VM_C_API void box_boolean(bool value, factor_vm *vm);
VM_C_API bool to_boolean(cell value, factor_vm *vm); VM_C_API bool to_boolean(cell value, factor_vm *vm);
VM_C_API cell from_boolean(bool value, factor_vm *vm);
/* Cannot allocate */
inline static bool to_boolean(cell value) inline static bool to_boolean(cell value)
{ {
return value != false_object; return value != false_object;

8
vm/byte_arrays.cpp
View File

@ -13,21 +13,21 @@ byte_array *factor_vm::allot_byte_array(cell size)
void factor_vm::primitive_byte_array() void factor_vm::primitive_byte_array()
{ {
cell size = unbox_array_size(); cell size = unbox_array_size();
dpush(tag<byte_array>(allot_byte_array(size))); ctx->push(tag<byte_array>(allot_byte_array(size)));
} }
void factor_vm::primitive_uninitialized_byte_array() void factor_vm::primitive_uninitialized_byte_array()
{ {
cell size = unbox_array_size(); cell size = unbox_array_size();
dpush(tag<byte_array>(allot_uninitialized_array<byte_array>(size))); ctx->push(tag<byte_array>(allot_uninitialized_array<byte_array>(size)));
} }
void factor_vm::primitive_resize_byte_array() void factor_vm::primitive_resize_byte_array()
{ {
data_root<byte_array> array(dpop(),this); data_root<byte_array> array(ctx->pop(),this);
array.untag_check(this); array.untag_check(this);
cell capacity = unbox_array_size(); cell capacity = unbox_array_size();
dpush(tag<byte_array>(reallot_array(array.untagged(),capacity))); ctx->push(tag<byte_array>(reallot_array(array.untagged(),capacity)));
} }
void growable_byte_array::append_bytes(void *elts, cell len) void growable_byte_array::append_bytes(void *elts, cell len)

4
vm/callbacks.cpp
View File

@ -81,9 +81,9 @@ void callback_heap::update()
void factor_vm::primitive_callback() void factor_vm::primitive_callback()
{ {
tagged<word> w(dpop()); tagged<word> w(ctx->pop());
w.untag_check(this); w.untag_check(this);
box_alien(callbacks->add(w.value())->xt()); ctx->push(allot_alien(callbacks->add(w.value())->xt()));
} }
} }

34
vm/callstack.cpp
View File

@ -57,14 +57,15 @@ void factor_vm::primitive_callstack()
callstack *stack = allot_callstack(size); callstack *stack = allot_callstack(size);
memcpy(stack->top(),top,size); memcpy(stack->top(),top,size);
dpush(tag<callstack>(stack)); ctx->push(tag<callstack>(stack));
} }
void factor_vm::primitive_set_callstack() void factor_vm::primitive_set_callstack()
{ {
callstack *stack = untag_check<callstack>(dpop()); callstack *stack = untag_check<callstack>(ctx->pop());
set_callstack(ctx->callstack_bottom, set_callstack(this,
ctx->callstack_bottom,
stack->top(), stack->top(),
untag_fixnum(stack->length), untag_fixnum(stack->length),
memcpy); memcpy);
@ -157,13 +158,13 @@ struct stack_frame_accumulator {
void factor_vm::primitive_callstack_to_array() void factor_vm::primitive_callstack_to_array()
{ {
data_root<callstack> callstack(dpop(),this); data_root<callstack> callstack(ctx->pop(),this);
stack_frame_accumulator accum(this); stack_frame_accumulator accum(this);
iterate_callstack_object(callstack.untagged(),accum); iterate_callstack_object(callstack.untagged(),accum);
accum.frames.trim(); accum.frames.trim();
dpush(accum.frames.elements.value()); ctx->push(accum.frames.elements.value());
} }
stack_frame *factor_vm::innermost_stack_frame(callstack *stack) stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
@ -182,20 +183,20 @@ stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
Used by the single stepper. */ Used by the single stepper. */
void factor_vm::primitive_innermost_stack_frame_executing() void factor_vm::primitive_innermost_stack_frame_executing()
{ {
stack_frame *frame = innermost_stack_frame(untag_check<callstack>(dpop())); stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
dpush(frame_executing_quot(frame)); ctx->push(frame_executing_quot(frame));
} }
void factor_vm::primitive_innermost_stack_frame_scan() void factor_vm::primitive_innermost_stack_frame_scan()
{ {
stack_frame *frame = innermost_stack_frame(untag_check<callstack>(dpop())); stack_frame *frame = innermost_stack_frame(untag_check<callstack>(ctx->pop()));
dpush(frame_scan(frame)); ctx->push(frame_scan(frame));
} }
void factor_vm::primitive_set_innermost_stack_frame_quot() void factor_vm::primitive_set_innermost_stack_frame_quot()
{ {
data_root<callstack> callstack(dpop(),this); data_root<callstack> callstack(ctx->pop(),this);
data_root<quotation> quot(dpop(),this); data_root<quotation> quot(ctx->pop(),this);
callstack.untag_check(this); callstack.untag_check(this);
quot.untag_check(this); quot.untag_check(this);
@ -208,15 +209,4 @@ void factor_vm::primitive_set_innermost_stack_frame_quot()
FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset; FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
} }
/* called before entry into Factor code. */
void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
{
ctx->callstack_bottom = callstack_bottom;
}
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *parent)
{
return parent->save_callstack_bottom(callstack_bottom);
}
} }

2
vm/callstack.hpp
View File

@ -6,8 +6,6 @@ inline static cell callstack_size(cell size)
return sizeof(callstack) + size; return sizeof(callstack) + size;
} }
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *parent);
/* This is a little tricky. The iterator may allocate memory, so we /* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */ keep the callstack in a GC root and use relative offsets */
template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator) template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)

4
vm/code_heap.cpp
View File

@ -96,7 +96,7 @@ void factor_vm::update_code_heap_words()
void factor_vm::primitive_modify_code_heap() void factor_vm::primitive_modify_code_heap()
{ {
data_root<array> alist(dpop(),this); data_root<array> alist(ctx->pop(),this);
cell count = array_capacity(alist.untagged()); cell count = array_capacity(alist.untagged());
@ -163,7 +163,7 @@ code_heap_room factor_vm::code_room()
void factor_vm::primitive_code_room() void factor_vm::primitive_code_room()
{ {
code_heap_room room = code_room(); code_heap_room room = code_room();
dpush(tag<byte_array>(byte_array_from_value(&room))); ctx->push(tag<byte_array>(byte_array_from_value(&room)));
} }
struct stack_trace_stripper { struct stack_trace_stripper {

92
vm/contexts.cpp
View File

@ -8,42 +8,15 @@ context::context(cell ds_size, cell rs_size) :
callstack_bottom(NULL), callstack_bottom(NULL),
datastack(0), datastack(0),
retainstack(0), retainstack(0),
datastack_save(0),
retainstack_save(0),
magic_frame(NULL), magic_frame(NULL),
datastack_region(new segment(ds_size,false)), datastack_region(new segment(ds_size,false)),
retainstack_region(new segment(rs_size,false)), retainstack_region(new segment(rs_size,false)),
catchstack_save(0), catchstack_save(0),
current_callback_save(0), current_callback_save(0),
next(NULL) {} next(NULL)
void factor_vm::reset_datastack()
{ {
ds = ds_bot - sizeof(cell); reset_datastack();
} reset_retainstack();
void factor_vm::reset_retainstack()
{
rs = rs_bot - sizeof(cell);
}
static const cell stack_reserved = (64 * sizeof(cell));
void factor_vm::fix_stacks()
{
if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
}
/* called before entry into foreign C code. Note that ds and rs might
be stored in registers, so callbacks must save and restore the correct values */
void factor_vm::save_stacks()
{
if(ctx)
{
ctx->datastack = ds;
ctx->retainstack = rs;
}
} }
context *factor_vm::alloc_context() context *factor_vm::alloc_context()
@ -75,19 +48,6 @@ void factor_vm::nest_stacks(stack_frame *magic_frame)
new_ctx->callstack_bottom = (stack_frame *)-1; new_ctx->callstack_bottom = (stack_frame *)-1;
new_ctx->callstack_top = (stack_frame *)-1; new_ctx->callstack_top = (stack_frame *)-1;
/* note that these register values are not necessarily valid stack
pointers. they are merely saved non-volatile registers, and are
restored in unnest_stacks(). consider this scenario:
- factor code calls C function
- C function saves ds/cs registers (since they're non-volatile)
- C function clobbers them
- C function calls Factor callback
- Factor callback returns
- C function restores registers
- C function returns to Factor code */
new_ctx->datastack_save = ds;
new_ctx->retainstack_save = rs;
new_ctx->magic_frame = magic_frame; new_ctx->magic_frame = magic_frame;
/* save per-callback special_objects */ /* save per-callback special_objects */
@ -96,9 +56,6 @@ void factor_vm::nest_stacks(stack_frame *magic_frame)
new_ctx->next = ctx; new_ctx->next = ctx;
ctx = new_ctx; ctx = new_ctx;
reset_datastack();
reset_retainstack();
} }
void nest_stacks(stack_frame *magic_frame, factor_vm *parent) void nest_stacks(stack_frame *magic_frame, factor_vm *parent)
@ -109,9 +66,6 @@ void nest_stacks(stack_frame *magic_frame, factor_vm *parent)
/* called when leaving a compiled callback */ /* called when leaving a compiled callback */
void factor_vm::unnest_stacks() void factor_vm::unnest_stacks()
{ {
ds = ctx->datastack_save;
rs = ctx->retainstack_save;
/* restore per-callback special_objects */ /* restore per-callback special_objects */
special_objects[OBJ_CURRENT_CALLBACK] = ctx->current_callback_save; special_objects[OBJ_CURRENT_CALLBACK] = ctx->current_callback_save;
special_objects[OBJ_CATCHSTACK] = ctx->catchstack_save; special_objects[OBJ_CATCHSTACK] = ctx->catchstack_save;
@ -145,20 +99,20 @@ bool factor_vm::stack_to_array(cell bottom, cell top)
{ {
array *a = allot_uninitialized_array<array>(depth / sizeof(cell)); array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
memcpy(a + 1,(void*)bottom,depth); memcpy(a + 1,(void*)bottom,depth);
dpush(tag<array>(a)); ctx->push(tag<array>(a));
return true; return true;
} }
} }
void factor_vm::primitive_datastack() void factor_vm::primitive_datastack()
{ {
if(!stack_to_array(ds_bot,ds)) if(!stack_to_array(ctx->datastack_region->start,ctx->datastack))
general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL); general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL);
} }
void factor_vm::primitive_retainstack() void factor_vm::primitive_retainstack()
{ {
if(!stack_to_array(rs_bot,rs)) if(!stack_to_array(ctx->retainstack_region->start,ctx->retainstack))
general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL); general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL);
} }
@ -172,46 +126,48 @@ cell factor_vm::array_to_stack(array *array, cell bottom)
void factor_vm::primitive_set_datastack() void factor_vm::primitive_set_datastack()
{ {
ds = array_to_stack(untag_check<array>(dpop()),ds_bot); ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_region->start);
} }
void factor_vm::primitive_set_retainstack() void factor_vm::primitive_set_retainstack()
{ {
rs = array_to_stack(untag_check<array>(dpop()),rs_bot); ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_region->start);
} }
/* Used to implement call( */ /* Used to implement call( */
void factor_vm::primitive_check_datastack() void factor_vm::primitive_check_datastack()
{ {
fixnum out = to_fixnum(dpop()); fixnum out = to_fixnum(ctx->pop());
fixnum in = to_fixnum(dpop()); fixnum in = to_fixnum(ctx->pop());
fixnum height = out - in; fixnum height = out - in;
array *saved_datastack = untag_check<array>(dpop()); array *saved_datastack = untag_check<array>(ctx->pop());
fixnum saved_height = array_capacity(saved_datastack); fixnum saved_height = array_capacity(saved_datastack);
fixnum current_height = (ds - ds_bot + sizeof(cell)) / sizeof(cell); fixnum current_height = (ctx->datastack - ctx->datastack_region->start + sizeof(cell)) / sizeof(cell);
if(current_height - height != saved_height) if(current_height - height != saved_height)
dpush(false_object); ctx->push(false_object);
else else
{ {
fixnum i; cell *ds_bot = (cell *)ctx->datastack_region->start;
for(i = 0; i < saved_height - in; i++) for(fixnum i = 0; i < saved_height - in; i++)
{ {
if(((cell *)ds_bot)[i] != array_nth(saved_datastack,i)) if(ds_bot[i] != array_nth(saved_datastack,i))
{ {
dpush(false_object); ctx->push(false_object);
return; return;
} }
} }
dpush(true_object); ctx->push(true_object);
} }
} }
void factor_vm::primitive_load_locals() void factor_vm::primitive_load_locals()
{ {
fixnum count = untag_fixnum(dpop()); fixnum count = untag_fixnum(ctx->pop());
memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count); memcpy((cell *)(ctx->retainstack + sizeof(cell)),
ds -= sizeof(cell) * count; (cell *)(ctx->datastack - sizeof(cell) * (count - 1)),
rs += sizeof(cell) * count; sizeof(cell) * count);
ctx->datastack -= sizeof(cell) * count;
ctx->retainstack += sizeof(cell) * count;
} }
} }

78
vm/contexts.hpp
View File

@ -1,11 +1,7 @@
namespace factor namespace factor
{ {
/* Assembly code makes assumptions about the layout of this struct: /* Assembly code makes assumptions about the layout of this struct */
- callstack_top field is 0
- callstack_bottom field is 1
- datastack field is 2
- retainstack field is 3 */
struct context { struct context {
/* C stack pointer on entry */ /* C stack pointer on entry */
stack_frame *callstack_top; stack_frame *callstack_top;
@ -17,12 +13,6 @@ struct context {
/* current retain stack top pointer */ /* current retain stack top pointer */
cell retainstack; cell retainstack;
/* saved contents of ds register on entry to callback */
cell datastack_save;
/* saved contents of rs register on entry to callback */
cell retainstack_save;
/* callback-bottom stack frame, or NULL for top-level context. /* callback-bottom stack frame, or NULL for top-level context.
When nest_stacks() is called, callstack layout with callbacks When nest_stacks() is called, callstack layout with callbacks
is as follows: is as follows:
@ -48,35 +38,53 @@ struct context {
context *next; context *next;
context(cell ds_size, cell rs_size); context(cell ds_size, cell rs_size);
};
#define ds_bot (ctx->datastack_region->start) cell peek()
#define ds_top (ctx->datastack_region->end) {
#define rs_bot (ctx->retainstack_region->start) return *(cell *)datastack;
#define rs_top (ctx->retainstack_region->end) }
inline cell dpeek() void replace(cell tagged)
{ {
return *(cell *)ds; *(cell *)datastack = tagged;
} }
inline void drepl(cell tagged) cell pop()
{ {
*(cell *)ds = tagged; cell value = peek();
} datastack -= sizeof(cell);
inline cell dpop()
{
cell value = dpeek();
ds -= sizeof(cell);
return value; return value;
} }
inline void dpush(cell tagged) void push(cell tagged)
{ {
ds += sizeof(cell); datastack += sizeof(cell);
drepl(tagged); replace(tagged);
} }
void reset_datastack()
{
datastack = datastack_region->start - sizeof(cell);
}
void reset_retainstack()
{
retainstack = retainstack_region->start - sizeof(cell);
}
static const cell stack_reserved = (64 * sizeof(cell));
void fix_stacks()
{
if(datastack + sizeof(cell) < datastack_region->start
|| datastack + stack_reserved >= datastack_region->end)
reset_datastack();
if(retainstack + sizeof(cell) < retainstack_region->start
|| retainstack + stack_reserved >= retainstack_region->end)
reset_retainstack();
}
};
VM_C_API void nest_stacks(stack_frame *magic_frame, factor_vm *vm); VM_C_API void nest_stacks(stack_frame *magic_frame, factor_vm *vm);
VM_C_API void unnest_stacks(factor_vm *vm); VM_C_API void unnest_stacks(factor_vm *vm);

76
vm/cpu-x86.32.S
View File

@ -5,6 +5,7 @@
#define ARG2 %ecx #define ARG2 %ecx
#define STACK_REG %esp #define STACK_REG %esp
#define DS_REG %esi #define DS_REG %esi
#define RS_REG %edi
#define RETURN_REG %eax #define RETURN_REG %eax
#define NV0 %ebx #define NV0 %ebx
@ -15,22 +16,24 @@
#define PUSH_NONVOLATILE \ #define PUSH_NONVOLATILE \
push %ebx ; \ push %ebx ; \
push %ebp push %ebp ; \
push %esi ; \
push %edi
#define POP_NONVOLATILE \ #define POP_NONVOLATILE \
pop %edi ; \
pop %esi ; \
pop %ebp ; \ pop %ebp ; \
pop %ebx pop %ebx
#define QUOT_XT_OFFSET 12 #define QUOT_XT_OFFSET 12
/* We pass a function pointer to memcpy to work around a Mac OS X DEF(void,set_callstack,(void *vm, stack_frame *to, stack_frame *from, cell length, void *memcpy)):
ABI limitation which would otherwise require us to do a bizzaro PC-relative mov 4(%esp),%ebx /* vm */
trampoline to retrieve the function address */ mov 8(%esp),%ebp /* to */
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)): mov 12(%esp),%edx /* from */
mov 4(%esp),%ebp /* to */ mov 16(%esp),%ecx /* length */
mov 8(%esp),%edx /* from */ mov 20(%esp),%eax /* memcpy */
mov 12(%esp),%ecx /* length */
mov 16(%esp),%eax /* memcpy */
sub %ecx,%ebp /* compute new stack pointer */ sub %ecx,%ebp /* compute new stack pointer */
mov %ebp,%esp mov %ebp,%esp
push %ecx /* pass length */ push %ecx /* pass length */
@ -38,29 +41,50 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi
push %ebp /* pass dst */ push %ebp /* pass dst */
call *%eax /* call memcpy */ call *%eax /* call memcpy */
add $12,%esp /* pop args from the stack */ add $12,%esp /* pop args from the stack */
mov (%ebx),%ebx /* load context */
mov 8(%ebx),DS_REG /* load datastack */
mov 12(%ebx),RS_REG /* load retainstack */
ret /* return _with new stack_ */ ret /* return _with new stack_ */
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)): DEF(void,throw_impl,(cell quot, void *new_stack, void *vm)):
mov ARG2,NV0 /* remember vm ptr in case quot_xt = lazy_jit_compile */
/* clear x87 stack, but preserve rounding mode and exception flags */ /* clear x87 stack, but preserve rounding mode and exception flags */
sub $2,STACK_REG sub $2,%esp
fnstcw (STACK_REG) fnstcw (%esp)
fninit fninit
fldcw (STACK_REG) fldcw (%esp)
/* rewind_to */ add $2,%esp
mov ARG1,STACK_REG /* load quotation and vm parameters */
mov NV0,ARG1 mov 4(%esp),%eax
jmp *QUOT_XT_OFFSET(ARG0) mov 12(%esp),%edx
/* load new stack pointer */
mov 8(%esp),%esp
/* load context */
mov (%edx),%ebx
/* load datastack */
mov 8(%ebx),DS_REG
/* load retainstack */
mov 12(%ebx),RS_REG
/* call the error handler */
jmp *QUOT_XT_OFFSET(%eax)
DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)): DEF(VM_ASM_API void,lazy_jit_compile,(cell quot, void *vm)):
mov ARG1,ARG2 /* load context */
mov STACK_REG,ARG1 /* Save stack pointer */ mov (ARG1),%ebx
sub $STACK_PADDING,STACK_REG /* save callstack */
lea -4(%esp),%ebp
mov %ebp,(%ebx)
/* save datastack */
mov DS_REG,8(%ebx)
/* save retainstack */
mov RS_REG,12(%ebx)
/* compile quotation */
sub $4,%esp
push ARG1
push ARG0
call MANGLE(lazy_jit_compile_impl) call MANGLE(lazy_jit_compile_impl)
mov RETURN_REG,ARG0 /* No-op on 32-bit */ add $12,%esp
add $STACK_PADDING,STACK_REG /* call quotation */
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */ jmp *QUOT_XT_OFFSET(%eax)
DEF(long long,read_timestamp_counter,(void)): DEF(long long,read_timestamp_counter,(void)):
rdtsc rdtsc

5
vm/cpu-x86.32.hpp
View File

@ -2,9 +2,6 @@ namespace factor
{ {
#define FACTOR_CPU_STRING "x86.32" #define FACTOR_CPU_STRING "x86.32"
register cell ds asm("esi");
register cell rs asm("edi");
#define VM_ASM_API VM_C_API __attribute__ ((regparm (3))) #define VM_ASM_API VM_C_API __attribute__ ((regparm (3)))
} }

15
vm/cpu-x86.S
View File

@ -12,9 +12,18 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
/* Create register shadow area for Win64 */ /* Create register shadow area for Win64 */
sub $32,STACK_REG sub $32,STACK_REG
/* Save stack pointer */ /* Load context */
lea -CELL_SIZE(STACK_REG),ARG0 mov (NV1),ARG0
call MANGLE(save_callstack_bottom)
/* Save ctx->callstack_bottom */
lea -CELL_SIZE(STACK_REG),ARG1
mov ARG1,CELL_SIZE(ARG0)
/* Load ctx->datastack */
mov (CELL_SIZE * 2)(ARG0),DS_REG
/* Load ctx->retainstack */
mov (CELL_SIZE * 3)(ARG0),RS_REG
/* Call quot-xt */ /* Call quot-xt */
mov NV0,ARG0 mov NV0,ARG0

6
vm/cpu-x86.hpp
View File

@ -75,10 +75,12 @@ inline static unsigned int fpu_status(unsigned int status)
/* Defined in assembly */ /* Defined in assembly */
VM_ASM_API void c_to_factor(cell quot, void *vm); VM_ASM_API void c_to_factor(cell quot, void *vm);
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to, void *vm); VM_C_API void throw_impl(cell quot, void *new_stack, void *vm);
VM_ASM_API void lazy_jit_compile(cell quot, void *vm); VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
VM_C_API void set_callstack(stack_frame *to, VM_C_API void set_callstack(
void *vm,
stack_frame *to,
stack_frame *from, stack_frame *from,
cell length, cell length,
void *(*memcpy)(void*,const void*, size_t)); void *(*memcpy)(void*,const void*, size_t));

4
vm/data_heap.cpp
View File

@ -230,7 +230,7 @@ data_heap_room factor_vm::data_room()
void factor_vm::primitive_data_room() void factor_vm::primitive_data_room()
{ {
data_heap_room room = data_room(); data_heap_room room = data_room();
dpush(tag<byte_array>(byte_array_from_value(&room))); ctx->push(tag<byte_array>(byte_array_from_value(&room)));
} }
struct object_accumulator { struct object_accumulator {
@ -265,7 +265,7 @@ cell factor_vm::instances(cell type)
void factor_vm::primitive_all_instances() void factor_vm::primitive_all_instances()
{ {
primitive_full_gc(); primitive_full_gc();
dpush(instances(TYPE_COUNT)); ctx->push(instances(TYPE_COUNT));
} }
} }

10
vm/debug.cpp
View File

@ -145,13 +145,13 @@ void factor_vm::print_objects(cell *start, cell *end)
void factor_vm::print_datastack() void factor_vm::print_datastack()
{ {
std::cout << "==== DATA STACK:\n"; std::cout << "==== DATA STACK:\n";
print_objects((cell *)ds_bot,(cell *)ds); print_objects((cell *)ctx->datastack_region->start,(cell *)ctx->datastack);
} }
void factor_vm::print_retainstack() void factor_vm::print_retainstack()
{ {
std::cout << "==== RETAIN STACK:\n"; std::cout << "==== RETAIN STACK:\n";
print_objects((cell *)rs_bot,(cell *)rs); print_objects((cell *)ctx->retainstack_region->start,(cell *)ctx->retainstack);
} }
struct stack_frame_printer { struct stack_frame_printer {
@ -421,9 +421,9 @@ void factor_vm::factorbug()
else if(strcmp(cmd,"t") == 0) else if(strcmp(cmd,"t") == 0)
full_output = !full_output; full_output = !full_output;
else if(strcmp(cmd,"s") == 0) else if(strcmp(cmd,"s") == 0)
dump_memory(ds_bot,ds); dump_memory(ctx->datastack_region->start,ctx->datastack);
else if(strcmp(cmd,"r") == 0) else if(strcmp(cmd,"r") == 0)
dump_memory(rs_bot,rs); dump_memory(ctx->retainstack_region->start,ctx->retainstack);
else if(strcmp(cmd,".s") == 0) else if(strcmp(cmd,".s") == 0)
print_datastack(); print_datastack();
else if(strcmp(cmd,".r") == 0) else if(strcmp(cmd,".r") == 0)
@ -459,7 +459,7 @@ void factor_vm::factorbug()
else if(strcmp(cmd,"push") == 0) else if(strcmp(cmd,"push") == 0)
{ {
cell addr = read_cell_hex(); cell addr = read_cell_hex();
dpush(addr); ctx->push(addr);
} }
else if(strcmp(cmd,"code") == 0) else if(strcmp(cmd,"code") == 0)
dump_code_heap(); dump_code_heap();

18
vm/dispatch.cpp
View File

@ -88,9 +88,9 @@ cell factor_vm::lookup_method(cell obj, cell methods)
void factor_vm::primitive_lookup_method() void factor_vm::primitive_lookup_method()
{ {
cell methods = dpop(); cell methods = ctx->pop();
cell obj = dpop(); cell obj = ctx->pop();
dpush(lookup_method(obj,methods)); ctx->push(lookup_method(obj,methods));
} }
cell factor_vm::object_class(cell obj) cell factor_vm::object_class(cell obj)
@ -120,17 +120,17 @@ void factor_vm::primitive_mega_cache_miss()
{ {
dispatch_stats.megamorphic_cache_misses++; dispatch_stats.megamorphic_cache_misses++;
cell cache = dpop(); cell cache = ctx->pop();
fixnum index = untag_fixnum(dpop()); fixnum index = untag_fixnum(ctx->pop());
cell methods = dpop(); cell methods = ctx->pop();
cell object = ((cell *)ds)[-index]; cell object = ((cell *)ctx->datastack)[-index];
cell klass = object_class(object); cell klass = object_class(object);
cell method = lookup_method(object,methods); cell method = lookup_method(object,methods);
update_method_cache(cache,klass,method); update_method_cache(cache,klass,method);
dpush(method); ctx->push(method);
} }
void factor_vm::primitive_reset_dispatch_stats() void factor_vm::primitive_reset_dispatch_stats()
@ -140,7 +140,7 @@ void factor_vm::primitive_reset_dispatch_stats()
void factor_vm::primitive_dispatch_stats() void factor_vm::primitive_dispatch_stats()
{ {
dpush(tag<byte_array>(byte_array_from_value(&dispatch_stats))); ctx->push(tag<byte_array>(byte_array_from_value(&dispatch_stats)));
} }
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_) void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)

14
vm/errors.cpp
View File

@ -43,9 +43,9 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top)
/* If we had an underflow or overflow, stack pointers might be /* If we had an underflow or overflow, stack pointers might be
out of bounds */ out of bounds */
fix_stacks(); ctx->fix_stacks();
dpush(error); ctx->push(error);
/* Errors thrown from C code pass NULL for this parameter. /* Errors thrown from C code pass NULL for this parameter.
Errors thrown from Factor code, or signal handlers, pass the Errors thrown from Factor code, or signal handlers, pass the
@ -99,13 +99,13 @@ bool factor_vm::in_page(cell fault, cell area, cell area_size, int offset)
void factor_vm::memory_protection_error(cell addr, stack_frame *native_stack) void factor_vm::memory_protection_error(cell addr, stack_frame *native_stack)
{ {
if(in_page(addr, ds_bot, 0, -1)) if(in_page(addr, ctx->datastack_region->start, 0, -1))
general_error(ERROR_DS_UNDERFLOW,false_object,false_object,native_stack); general_error(ERROR_DS_UNDERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, ds_bot, ds_size, 0)) else if(in_page(addr, ctx->datastack_region->start, ds_size, 0))
general_error(ERROR_DS_OVERFLOW,false_object,false_object,native_stack); general_error(ERROR_DS_OVERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, rs_bot, 0, -1)) else if(in_page(addr, ctx->retainstack_region->start, 0, -1))
general_error(ERROR_RS_UNDERFLOW,false_object,false_object,native_stack); general_error(ERROR_RS_UNDERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, rs_bot, rs_size, 0)) else if(in_page(addr, ctx->retainstack_region->start, rs_size, 0))
general_error(ERROR_RS_OVERFLOW,false_object,false_object,native_stack); general_error(ERROR_RS_OVERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, nursery.end, 0, 0)) else if(in_page(addr, nursery.end, 0, 0))
critical_error("allot_object() missed GC check",0); critical_error("allot_object() missed GC check",0);
@ -130,7 +130,7 @@ void factor_vm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_calls
void factor_vm::primitive_call_clear() void factor_vm::primitive_call_clear()
{ {
throw_impl(dpop(),ctx->callstack_bottom,this); throw_impl(ctx->pop(),ctx->callstack_bottom,this);
} }
/* For testing purposes */ /* For testing purposes */

4
vm/factor.cpp
View File

@ -152,11 +152,9 @@ void factor_vm::init_factor(vm_parameters *p)
void factor_vm::pass_args_to_factor(int argc, vm_char **argv) void factor_vm::pass_args_to_factor(int argc, vm_char **argv)
{ {
growable_array args(this); growable_array args(this);
int i;
for(i = 1; i < argc; i++){ for(fixnum i = 1; i < argc; i++)
args.add(allot_alien(false_object,(cell)argv[i])); args.add(allot_alien(false_object,(cell)argv[i]));
}
args.trim(); args.trim();
special_objects[OBJ_ARGS] = args.elements.value(); special_objects[OBJ_ARGS] = args.elements.value();

6
vm/gc.cpp
View File

@ -131,8 +131,6 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
assert(!gc_off); assert(!gc_off);
assert(!current_gc); assert(!current_gc);
save_stacks();
current_gc = new gc_state(op,this); current_gc = new gc_state(op,this);
/* Keep trying to GC higher and higher generations until we don't run out /* Keep trying to GC higher and higher generations until we don't run out
@ -277,12 +275,12 @@ void factor_vm::primitive_disable_gc_events()
} }
result.trim(); result.trim();
dpush(result.elements.value()); ctx->push(result.elements.value());
delete this->gc_events; delete this->gc_events;
} }
else else
dpush(false_object); ctx->push(false_object);
} }
} }

4
vm/image.cpp
View File

@ -314,7 +314,7 @@ void factor_vm::primitive_save_image()
/* do a full GC to push everything into tenured space */ /* do a full GC to push everything into tenured space */
primitive_compact_gc(); primitive_compact_gc();
data_root<byte_array> path(dpop(),this); data_root<byte_array> path(ctx->pop(),this);
path.untag_check(this); path.untag_check(this);
save_image((vm_char *)(path.untagged() + 1)); save_image((vm_char *)(path.untagged() + 1));
} }
@ -324,7 +324,7 @@ void factor_vm::primitive_save_image_and_exit()
/* We unbox this before doing anything else. This is the only point /* 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 where we might throw an error, so we have to throw an error here since
later steps destroy the current image. */ later steps destroy the current image. */
data_root<byte_array> path(dpop(),this); data_root<byte_array> path(ctx->pop(),this);
path.untag_check(this); path.untag_check(this);
/* strip out special_objects data which is set on startup anyway */ /* strip out special_objects data which is set on startup anyway */

10
vm/inline_cache.cpp
View File

@ -198,11 +198,11 @@ void *factor_vm::inline_cache_miss(cell return_address_)
<< std::endl; << std::endl;
#endif #endif
data_root<array> cache_entries(dpop(),this); data_root<array> cache_entries(ctx->pop(),this);
fixnum index = untag_fixnum(dpop()); fixnum index = untag_fixnum(ctx->pop());
data_root<array> methods(dpop(),this); data_root<array> methods(ctx->pop(),this);
data_root<word> generic_word(dpop(),this); data_root<word> generic_word(ctx->pop(),this);
data_root<object> object(((cell *)ds)[-index],this); data_root<object> object(((cell *)ctx->datastack)[-index],this);
cell pic_size = inline_cache_size(cache_entries.value()); cell pic_size = inline_cache_size(cache_entries.value());

47
vm/io.cpp
View File

@ -33,8 +33,8 @@ void factor_vm::io_error()
void factor_vm::primitive_fopen() void factor_vm::primitive_fopen()
{ {
data_root<byte_array> mode(dpop(),this); data_root<byte_array> mode(ctx->pop(),this);
data_root<byte_array> path(dpop(),this); data_root<byte_array> path(ctx->pop(),this);
mode.untag_check(this); mode.untag_check(this);
path.untag_check(this); path.untag_check(this);
@ -46,15 +46,20 @@ void factor_vm::primitive_fopen()
io_error(); io_error();
else else
{ {
box_alien(file); ctx->push(allot_alien(file));
break; break;
} }
} }
} }
FILE *factor_vm::pop_file_handle()
{
return (FILE *)alien_offset(ctx->pop());
}
void factor_vm::primitive_fgetc() void factor_vm::primitive_fgetc()
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
for(;;) for(;;)
{ {
@ -63,7 +68,7 @@ void factor_vm::primitive_fgetc()
{ {
if(feof(file)) if(feof(file))
{ {
dpush(false_object); ctx->push(false_object);
break; break;
} }
else else
@ -71,7 +76,7 @@ void factor_vm::primitive_fgetc()
} }
else else
{ {
dpush(tag_fixnum(c)); ctx->push(tag_fixnum(c));
break; break;
} }
} }
@ -79,12 +84,12 @@ void factor_vm::primitive_fgetc()
void factor_vm::primitive_fread() void factor_vm::primitive_fread()
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
fixnum size = unbox_array_size(); fixnum size = unbox_array_size();
if(size == 0) if(size == 0)
{ {
dpush(tag<string>(allot_string(0,0))); ctx->push(tag<string>(allot_string(0,0)));
return; return;
} }
@ -97,7 +102,7 @@ void factor_vm::primitive_fread()
{ {
if(feof(file)) if(feof(file))
{ {
dpush(false_object); ctx->push(false_object);
break; break;
} }
else else
@ -111,7 +116,7 @@ void factor_vm::primitive_fread()
memcpy(new_buf + 1, buf.untagged() + 1,c); memcpy(new_buf + 1, buf.untagged() + 1,c);
buf = new_buf; buf = new_buf;
} }
dpush(buf.value()); ctx->push(buf.value());
break; break;
} }
} }
@ -119,8 +124,8 @@ void factor_vm::primitive_fread()
void factor_vm::primitive_fputc() void factor_vm::primitive_fputc()
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
fixnum ch = to_fixnum(dpop()); fixnum ch = to_fixnum(ctx->pop());
for(;;) for(;;)
{ {
@ -137,8 +142,8 @@ void factor_vm::primitive_fputc()
void factor_vm::primitive_fwrite() void factor_vm::primitive_fwrite()
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
byte_array *text = untag_check<byte_array>(dpop()); byte_array *text = untag_check<byte_array>(ctx->pop());
cell length = array_capacity(text); cell length = array_capacity(text);
char *string = (char *)(text + 1); char *string = (char *)(text + 1);
@ -166,20 +171,20 @@ void factor_vm::primitive_fwrite()
void factor_vm::primitive_ftell() void factor_vm::primitive_ftell()
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
off_t offset; off_t offset;
if((offset = FTELL(file)) == -1) if((offset = FTELL(file)) == -1)
io_error(); io_error();
box_signed_8(offset); ctx->push(from_signed_8(offset));
} }
void factor_vm::primitive_fseek() void factor_vm::primitive_fseek()
{ {
int whence = to_fixnum(dpop()); int whence = to_fixnum(ctx->pop());
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
off_t offset = to_signed_8(dpop()); off_t offset = to_signed_8(ctx->pop());
switch(whence) switch(whence)
{ {
@ -202,7 +207,7 @@ void factor_vm::primitive_fseek()
void factor_vm::primitive_fflush() void factor_vm::primitive_fflush()
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
for(;;) for(;;)
{ {
if(fflush(file) == EOF) if(fflush(file) == EOF)
@ -214,7 +219,7 @@ void factor_vm::primitive_fflush()
void factor_vm::primitive_fclose() void factor_vm::primitive_fclose()
{ {
FILE *file = (FILE *)unbox_alien(); FILE *file = pop_file_handle();
for(;;) for(;;)
{ {
if(fclose(file) == EOF) if(fclose(file) == EOF)

261
vm/math.cpp
View File

@ -5,40 +5,40 @@ namespace factor
void factor_vm::primitive_bignum_to_fixnum() void factor_vm::primitive_bignum_to_fixnum()
{ {
drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek())))); ctx->replace(tag_fixnum(bignum_to_fixnum(untag<bignum>(ctx->peek()))));
} }
void factor_vm::primitive_float_to_fixnum() void factor_vm::primitive_float_to_fixnum()
{ {
drepl(tag_fixnum(float_to_fixnum(dpeek()))); ctx->replace(tag_fixnum(float_to_fixnum(ctx->peek())));
} }
/* Division can only overflow when we are dividing the most negative fixnum /* Division can only overflow when we are dividing the most negative fixnum
by -1. */ by -1. */
void factor_vm::primitive_fixnum_divint() void factor_vm::primitive_fixnum_divint()
{ {
fixnum y = untag_fixnum(dpop()); \ fixnum y = untag_fixnum(ctx->pop()); \
fixnum x = untag_fixnum(dpeek()); fixnum x = untag_fixnum(ctx->peek());
fixnum result = x / y; fixnum result = x / y;
if(result == -fixnum_min) if(result == -fixnum_min)
drepl(allot_integer(-fixnum_min)); ctx->replace(allot_integer(-fixnum_min));
else else
drepl(tag_fixnum(result)); ctx->replace(tag_fixnum(result));
} }
void factor_vm::primitive_fixnum_divmod() void factor_vm::primitive_fixnum_divmod()
{ {
cell y = ((cell *)ds)[0]; cell y = ((cell *)ctx->datastack)[0];
cell x = ((cell *)ds)[-1]; cell x = ((cell *)ctx->datastack)[-1];
if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min)) if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min))
{ {
((cell *)ds)[-1] = allot_integer(-fixnum_min); ((cell *)ctx->datastack)[-1] = allot_integer(-fixnum_min);
((cell *)ds)[0] = tag_fixnum(0); ((cell *)ctx->datastack)[0] = tag_fixnum(0);
} }
else else
{ {
((cell *)ds)[-1] = tag_fixnum(untag_fixnum(x) / untag_fixnum(y)); ((cell *)ctx->datastack)[-1] = tag_fixnum(untag_fixnum(x) / untag_fixnum(y));
((cell *)ds)[0] = (fixnum)x % (fixnum)y; ((cell *)ctx->datastack)[0] = (fixnum)x % (fixnum)y;
} }
} }
@ -63,15 +63,15 @@ inline fixnum factor_vm::branchless_abs(fixnum x)
void factor_vm::primitive_fixnum_shift() void factor_vm::primitive_fixnum_shift()
{ {
fixnum y = untag_fixnum(dpop()); fixnum y = untag_fixnum(ctx->pop());
fixnum x = untag_fixnum(dpeek()); fixnum x = untag_fixnum(ctx->peek());
if(x == 0) if(x == 0)
return; return;
else if(y < 0) else if(y < 0)
{ {
y = branchless_max(y,-WORD_SIZE + 1); y = branchless_max(y,-WORD_SIZE + 1);
drepl(tag_fixnum(x >> -y)); ctx->replace(tag_fixnum(x >> -y));
return; return;
} }
else if(y < WORD_SIZE - TAG_BITS) else if(y < WORD_SIZE - TAG_BITS)
@ -79,57 +79,57 @@ void factor_vm::primitive_fixnum_shift()
fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y)); fixnum mask = -((fixnum)1 << (WORD_SIZE - 1 - TAG_BITS - y));
if(!(branchless_abs(x) & mask)) if(!(branchless_abs(x) & mask))
{ {
drepl(tag_fixnum(x << y)); ctx->replace(tag_fixnum(x << y));
return; return;
} }
} }
drepl(tag<bignum>(bignum_arithmetic_shift( ctx->replace(tag<bignum>(bignum_arithmetic_shift(
fixnum_to_bignum(x),y))); fixnum_to_bignum(x),y)));
} }
void factor_vm::primitive_fixnum_to_bignum() void factor_vm::primitive_fixnum_to_bignum()
{ {
drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek())))); ctx->replace(tag<bignum>(fixnum_to_bignum(untag_fixnum(ctx->peek()))));
} }
void factor_vm::primitive_float_to_bignum() void factor_vm::primitive_float_to_bignum()
{ {
drepl(tag<bignum>(float_to_bignum(dpeek()))); ctx->replace(tag<bignum>(float_to_bignum(ctx->peek())));
} }
#define POP_BIGNUMS(x,y) \ #define POP_BIGNUMS(x,y) \
bignum * y = untag<bignum>(dpop()); \ bignum * y = untag<bignum>(ctx->pop()); \
bignum * x = untag<bignum>(dpop()); bignum * x = untag<bignum>(ctx->pop());
void factor_vm::primitive_bignum_eq() void factor_vm::primitive_bignum_eq()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
box_boolean(bignum_equal_p(x,y)); ctx->push(tag_boolean(bignum_equal_p(x,y)));
} }
void factor_vm::primitive_bignum_add() void factor_vm::primitive_bignum_add()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_add(x,y))); ctx->push(tag<bignum>(bignum_add(x,y)));
} }
void factor_vm::primitive_bignum_subtract() void factor_vm::primitive_bignum_subtract()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_subtract(x,y))); ctx->push(tag<bignum>(bignum_subtract(x,y)));
} }
void factor_vm::primitive_bignum_multiply() void factor_vm::primitive_bignum_multiply()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_multiply(x,y))); ctx->push(tag<bignum>(bignum_multiply(x,y)));
} }
void factor_vm::primitive_bignum_divint() void factor_vm::primitive_bignum_divint()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_quotient(x,y))); ctx->push(tag<bignum>(bignum_quotient(x,y)));
} }
void factor_vm::primitive_bignum_divmod() void factor_vm::primitive_bignum_divmod()
@ -137,85 +137,85 @@ void factor_vm::primitive_bignum_divmod()
bignum *q, *r; bignum *q, *r;
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
bignum_divide(x,y,&q,&r); bignum_divide(x,y,&q,&r);
dpush(tag<bignum>(q)); ctx->push(tag<bignum>(q));
dpush(tag<bignum>(r)); ctx->push(tag<bignum>(r));
} }
void factor_vm::primitive_bignum_mod() void factor_vm::primitive_bignum_mod()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_remainder(x,y))); ctx->push(tag<bignum>(bignum_remainder(x,y)));
} }
void factor_vm::primitive_bignum_and() void factor_vm::primitive_bignum_and()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_and(x,y))); ctx->push(tag<bignum>(bignum_bitwise_and(x,y)));
} }
void factor_vm::primitive_bignum_or() void factor_vm::primitive_bignum_or()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_ior(x,y))); ctx->push(tag<bignum>(bignum_bitwise_ior(x,y)));
} }
void factor_vm::primitive_bignum_xor() void factor_vm::primitive_bignum_xor()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_xor(x,y))); ctx->push(tag<bignum>(bignum_bitwise_xor(x,y)));
} }
void factor_vm::primitive_bignum_shift() void factor_vm::primitive_bignum_shift()
{ {
fixnum y = untag_fixnum(dpop()); fixnum y = untag_fixnum(ctx->pop());
bignum* x = untag<bignum>(dpop()); bignum* x = untag<bignum>(ctx->pop());
dpush(tag<bignum>(bignum_arithmetic_shift(x,y))); ctx->push(tag<bignum>(bignum_arithmetic_shift(x,y)));
} }
void factor_vm::primitive_bignum_less() void factor_vm::primitive_bignum_less()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) == bignum_comparison_less); ctx->push(tag_boolean(bignum_compare(x,y) == bignum_comparison_less));
} }
void factor_vm::primitive_bignum_lesseq() void factor_vm::primitive_bignum_lesseq()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) != bignum_comparison_greater); ctx->push(tag_boolean(bignum_compare(x,y) != bignum_comparison_greater));
} }
void factor_vm::primitive_bignum_greater() void factor_vm::primitive_bignum_greater()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) == bignum_comparison_greater); ctx->push(tag_boolean(bignum_compare(x,y) == bignum_comparison_greater));
} }
void factor_vm::primitive_bignum_greatereq() void factor_vm::primitive_bignum_greatereq()
{ {
POP_BIGNUMS(x,y); POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) != bignum_comparison_less); ctx->push(tag_boolean(bignum_compare(x,y) != bignum_comparison_less));
} }
void factor_vm::primitive_bignum_not() void factor_vm::primitive_bignum_not()
{ {
drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek())))); ctx->replace(tag<bignum>(bignum_bitwise_not(untag<bignum>(ctx->peek()))));
} }
void factor_vm::primitive_bignum_bitp() void factor_vm::primitive_bignum_bitp()
{ {
fixnum bit = to_fixnum(dpop()); fixnum bit = to_fixnum(ctx->pop());
bignum *x = untag<bignum>(dpop()); bignum *x = untag<bignum>(ctx->pop());
box_boolean(bignum_logbitp(bit,x)); ctx->push(tag_boolean(bignum_logbitp(bit,x)));
} }
void factor_vm::primitive_bignum_log2() void factor_vm::primitive_bignum_log2()
{ {
drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek())))); ctx->replace(tag<bignum>(bignum_integer_length(untag<bignum>(ctx->peek()))));
} }
unsigned int factor_vm::bignum_producer(unsigned int digit) unsigned int factor_vm::bignum_producer(unsigned int digit)
{ {
unsigned char *ptr = (unsigned char *)alien_offset(dpeek()); unsigned char *ptr = (unsigned char *)alien_offset(ctx->peek());
return *(ptr + digit); return *(ptr + digit);
} }
@ -226,145 +226,146 @@ unsigned int bignum_producer(unsigned int digit, factor_vm *parent)
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())); cell n_digits = array_capacity(untag_check<byte_array>(ctx->peek()));
bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0); bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
drepl(tag<bignum>(result)); ctx->replace(tag<bignum>(result));
} }
cell factor_vm::unbox_array_size_slow() cell factor_vm::unbox_array_size_slow()
{ {
if(tagged<object>(dpeek()).type() == BIGNUM_TYPE) if(tagged<object>(ctx->peek()).type() == BIGNUM_TYPE)
{ {
bignum *zero = untag<bignum>(bignum_zero); bignum *zero = untag<bignum>(bignum_zero);
bignum *max = cell_to_bignum(array_size_max); bignum *max = cell_to_bignum(array_size_max);
bignum *n = untag<bignum>(dpeek()); bignum *n = untag<bignum>(ctx->peek());
if(bignum_compare(n,zero) != bignum_comparison_less if(bignum_compare(n,zero) != bignum_comparison_less
&& bignum_compare(n,max) == bignum_comparison_less) && bignum_compare(n,max) == bignum_comparison_less)
{ {
dpop(); ctx->pop();
return bignum_to_cell(n); return bignum_to_cell(n);
} }
} }
general_error(ERROR_ARRAY_SIZE,dpop(),tag_fixnum(array_size_max),NULL); general_error(ERROR_ARRAY_SIZE,ctx->pop(),tag_fixnum(array_size_max),NULL);
return 0; /* can't happen */ return 0; /* can't happen */
} }
void factor_vm::primitive_fixnum_to_float() void factor_vm::primitive_fixnum_to_float()
{ {
drepl(allot_float(fixnum_to_float(dpeek()))); ctx->replace(allot_float(fixnum_to_float(ctx->peek())));
} }
void factor_vm::primitive_bignum_to_float() void factor_vm::primitive_bignum_to_float()
{ {
drepl(allot_float(bignum_to_float(dpeek()))); ctx->replace(allot_float(bignum_to_float(ctx->peek())));
} }
void factor_vm::primitive_str_to_float() void factor_vm::primitive_str_to_float()
{ {
byte_array *bytes = untag_check<byte_array>(dpeek()); byte_array *bytes = untag_check<byte_array>(ctx->peek());
cell capacity = array_capacity(bytes); cell capacity = array_capacity(bytes);
char *c_str = (char *)(bytes + 1); char *c_str = (char *)(bytes + 1);
char *end = c_str; char *end = c_str;
double f = strtod(c_str,&end); double f = strtod(c_str,&end);
if(end == c_str + capacity - 1) if(end == c_str + capacity - 1)
drepl(allot_float(f)); ctx->replace(allot_float(f));
else else
drepl(false_object); ctx->replace(false_object);
} }
void factor_vm::primitive_float_to_str() void factor_vm::primitive_float_to_str()
{ {
byte_array *array = allot_byte_array(33); byte_array *array = allot_byte_array(33);
snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop())); snprintf((char *)(array + 1),32,"%.16g",untag_float_check(ctx->pop()));
dpush(tag<byte_array>(array)); ctx->push(tag<byte_array>(array));
} }
#define POP_FLOATS(x,y) \ #define POP_FLOATS(x,y) \
double y = untag_float(dpop()); \ double y = untag_float(ctx->pop()); \
double x = untag_float(dpop()); double x = untag_float(ctx->pop());
void factor_vm::primitive_float_eq() void factor_vm::primitive_float_eq()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_boolean(x == y); ctx->push(tag_boolean(x == y));
} }
void factor_vm::primitive_float_add() void factor_vm::primitive_float_add()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_double(x + y); ctx->push(allot_float(x + y));
} }
void factor_vm::primitive_float_subtract() void factor_vm::primitive_float_subtract()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_double(x - y); ctx->push(allot_float(x - y));
} }
void factor_vm::primitive_float_multiply() void factor_vm::primitive_float_multiply()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_double(x * y); ctx->push(allot_float(x * y));
} }
void factor_vm::primitive_float_divfloat() void factor_vm::primitive_float_divfloat()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_double(x / y); ctx->push(allot_float(x / y));
} }
void factor_vm::primitive_float_mod() void factor_vm::primitive_float_mod()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_double(fmod(x,y)); ctx->push(allot_float(fmod(x,y)));
} }
void factor_vm::primitive_float_less() void factor_vm::primitive_float_less()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_boolean(x < y); ctx->push(tag_boolean(x < y));
} }
void factor_vm::primitive_float_lesseq() void factor_vm::primitive_float_lesseq()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_boolean(x <= y); ctx->push(tag_boolean(x <= y));
} }
void factor_vm::primitive_float_greater() void factor_vm::primitive_float_greater()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_boolean(x > y); ctx->push(tag_boolean(x > y));
} }
void factor_vm::primitive_float_greatereq() void factor_vm::primitive_float_greatereq()
{ {
POP_FLOATS(x,y); POP_FLOATS(x,y);
box_boolean(x >= y); ctx->push(tag_boolean(x >= y));
} }
void factor_vm::primitive_float_bits() void factor_vm::primitive_float_bits()
{ {
box_unsigned_4(float_bits(untag_float_check(dpop()))); ctx->push(from_unsigned_4(float_bits(untag_float_check(ctx->pop()))));
} }
void factor_vm::primitive_bits_float() void factor_vm::primitive_bits_float()
{ {
box_float(bits_float(to_cell(dpop()))); ctx->push(allot_float(bits_float(to_cell(ctx->pop()))));
} }
void factor_vm::primitive_double_bits() void factor_vm::primitive_double_bits()
{ {
box_unsigned_8(double_bits(untag_float_check(dpop()))); ctx->push(from_unsigned_8(double_bits(untag_float_check(ctx->pop()))));
} }
void factor_vm::primitive_bits_double() void factor_vm::primitive_bits_double()
{ {
box_double(bits_double(to_unsigned_8(dpop()))); ctx->push(allot_float(bits_double(to_unsigned_8(ctx->pop()))));
} }
/* Cannot allocate */
fixnum factor_vm::to_fixnum(cell tagged) fixnum factor_vm::to_fixnum(cell tagged)
{ {
switch(TAG(tagged)) switch(TAG(tagged))
@ -394,99 +395,100 @@ VM_C_API cell to_cell(cell tagged, factor_vm *parent)
return parent->to_cell(tagged); return parent->to_cell(tagged);
} }
void factor_vm::box_signed_1(s8 n) cell factor_vm::from_signed_1(s8 n)
{ {
dpush(tag_fixnum(n)); return tag_fixnum(n);
} }
VM_C_API void box_signed_1(s8 n, factor_vm *parent) VM_C_API cell from_signed_1(s8 n, factor_vm *parent)
{ {
return parent->box_signed_1(n); return parent->from_signed_1(n);
} }
void factor_vm::box_unsigned_1(u8 n) cell factor_vm::from_unsigned_1(u8 n)
{ {
dpush(tag_fixnum(n)); return tag_fixnum(n);
} }
VM_C_API void box_unsigned_1(u8 n, factor_vm *parent) VM_C_API cell from_unsigned_1(u8 n, factor_vm *parent)
{ {
return parent->box_unsigned_1(n); return parent->from_unsigned_1(n);
} }
void factor_vm::box_signed_2(s16 n) cell factor_vm::from_signed_2(s16 n)
{ {
dpush(tag_fixnum(n)); return tag_fixnum(n);
} }
VM_C_API void box_signed_2(s16 n, factor_vm *parent) VM_C_API cell from_signed_2(s16 n, factor_vm *parent)
{ {
return parent->box_signed_2(n); return parent->from_signed_2(n);
} }
void factor_vm::box_unsigned_2(u16 n) cell factor_vm::from_unsigned_2(u16 n)
{ {
dpush(tag_fixnum(n)); return tag_fixnum(n);
} }
VM_C_API void box_unsigned_2(u16 n, factor_vm *parent) VM_C_API cell from_unsigned_2(u16 n, factor_vm *parent)
{ {
return parent->box_unsigned_2(n); return parent->from_unsigned_2(n);
} }
void factor_vm::box_signed_4(s32 n) cell factor_vm::from_signed_4(s32 n)
{ {
dpush(allot_integer(n)); return allot_integer(n);
} }
VM_C_API void box_signed_4(s32 n, factor_vm *parent) VM_C_API cell from_signed_4(s32 n, factor_vm *parent)
{ {
return parent->box_signed_4(n); return parent->from_signed_4(n);
} }
void factor_vm::box_unsigned_4(u32 n) cell factor_vm::from_unsigned_4(u32 n)
{ {
dpush(allot_cell(n)); return allot_cell(n);
} }
VM_C_API void box_unsigned_4(u32 n, factor_vm *parent) VM_C_API cell from_unsigned_4(u32 n, factor_vm *parent)
{ {
return parent->box_unsigned_4(n); return parent->from_unsigned_4(n);
} }
void factor_vm::box_signed_cell(fixnum integer) cell factor_vm::from_signed_cell(fixnum integer)
{ {
dpush(allot_integer(integer)); return allot_integer(integer);
} }
VM_C_API void box_signed_cell(fixnum integer, factor_vm *parent) cell factor_vm::from_unsigned_cell(cell integer)
{ {
return parent->box_signed_cell(integer); return allot_cell(integer);
} }
void factor_vm::box_unsigned_cell(cell cell) VM_C_API cell from_signed_cell(fixnum integer, factor_vm *parent)
{ {
dpush(allot_cell(cell)); return parent->from_signed_cell(integer);
} }
VM_C_API void box_unsigned_cell(cell cell, factor_vm *parent) VM_C_API cell from_unsigned_cell(cell integer, factor_vm *parent)
{ {
return parent->box_unsigned_cell(cell); return parent->from_unsigned_cell(integer);
} }
void factor_vm::box_signed_8(s64 n) cell factor_vm::from_signed_8(s64 n)
{ {
if(n < fixnum_min || n > fixnum_max) if(n < fixnum_min || n > fixnum_max)
dpush(tag<bignum>(long_long_to_bignum(n))); return tag<bignum>(long_long_to_bignum(n));
else else
dpush(tag_fixnum(n)); return tag_fixnum(n);
} }
VM_C_API void box_signed_8(s64 n, factor_vm *parent) VM_C_API cell from_signed_8(s64 n, factor_vm *parent)
{ {
return parent->box_signed_8(n); return parent->from_signed_8(n);
} }
/* Cannot allocate */
s64 factor_vm::to_signed_8(cell obj) s64 factor_vm::to_signed_8(cell obj)
{ {
switch(tagged<object>(obj).type()) switch(tagged<object>(obj).type())
@ -506,19 +508,20 @@ VM_C_API s64 to_signed_8(cell obj, factor_vm *parent)
return parent->to_signed_8(obj); return parent->to_signed_8(obj);
} }
void factor_vm::box_unsigned_8(u64 n) cell factor_vm::from_unsigned_8(u64 n)
{ {
if(n > (u64)fixnum_max) if(n > (u64)fixnum_max)
dpush(tag<bignum>(ulong_long_to_bignum(n))); return tag<bignum>(ulong_long_to_bignum(n));
else else
dpush(tag_fixnum(n)); return tag_fixnum(n);
} }
VM_C_API void box_unsigned_8(u64 n, factor_vm *parent) VM_C_API cell from_unsigned_8(u64 n, factor_vm *parent)
{ {
return parent->box_unsigned_8(n); return parent->from_unsigned_8(n);
} }
/* Cannot allocate */
u64 factor_vm::to_unsigned_8(cell obj) u64 factor_vm::to_unsigned_8(cell obj)
{ {
switch(tagged<object>(obj).type()) switch(tagged<object>(obj).type())
@ -538,16 +541,12 @@ VM_C_API u64 to_unsigned_8(cell obj, factor_vm *parent)
return parent->to_unsigned_8(obj); return parent->to_unsigned_8(obj);
} }
void factor_vm::box_float(float flo) VM_C_API cell from_float(float flo, factor_vm *parent)
{ {
dpush(allot_float(flo)); return parent->allot_float(flo);
}
VM_C_API void box_float(float flo, factor_vm *parent)
{
return parent->box_float(flo);
} }
/* Cannot allocate */
float factor_vm::to_float(cell value) float factor_vm::to_float(cell value)
{ {
return untag_float_check(value); return untag_float_check(value);
@ -558,16 +557,12 @@ VM_C_API float to_float(cell value, factor_vm *parent)
return parent->to_float(value); return parent->to_float(value);
} }
void factor_vm::box_double(double flo) VM_C_API cell from_double(double flo, factor_vm *parent)
{ {
dpush(allot_float(flo)); return parent->allot_float(flo);
}
VM_C_API void box_double(double flo, factor_vm *parent)
{
return parent->box_double(flo);
} }
/* Cannot allocate */
double factor_vm::to_double(cell value) double factor_vm::to_double(cell value)
{ {
return untag_float_check(value); return untag_float_check(value);
@ -582,7 +577,7 @@ VM_C_API double to_double(cell value, factor_vm *parent)
overflow, they call these functions. */ overflow, they call these functions. */
inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y) inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y)
{ {
drepl(tag<bignum>(fixnum_to_bignum( ctx->replace(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) + untag_fixnum(y)))); untag_fixnum(x) + untag_fixnum(y))));
} }
@ -593,7 +588,7 @@ VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *parent)
inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y) inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y)
{ {
drepl(tag<bignum>(fixnum_to_bignum( ctx->replace(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) - untag_fixnum(y)))); untag_fixnum(x) - untag_fixnum(y))));
} }
@ -608,7 +603,7 @@ inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y)
GC_BIGNUM(bx); GC_BIGNUM(bx);
bignum *by = fixnum_to_bignum(y); bignum *by = fixnum_to_bignum(y);
GC_BIGNUM(by); GC_BIGNUM(by);
drepl(tag<bignum>(bignum_multiply(bx,by))); ctx->replace(tag<bignum>(bignum_multiply(bx,by)));
} }
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *parent) VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *parent)

34
vm/math.hpp
View File

@ -60,13 +60,13 @@ inline double factor_vm::fixnum_to_float(cell tagged)
inline cell factor_vm::unbox_array_size() inline cell factor_vm::unbox_array_size()
{ {
cell obj = dpeek(); cell obj = ctx->peek();
if(TAG(obj) == FIXNUM_TYPE) if(TAG(obj) == FIXNUM_TYPE)
{ {
fixnum n = untag_fixnum(obj); fixnum n = untag_fixnum(obj);
if(n >= 0 && n < (fixnum)array_size_max) if(n >= 0 && n < (fixnum)array_size_max)
{ {
dpop(); ctx->pop();
return n; return n;
} }
} }
@ -74,21 +74,21 @@ inline cell factor_vm::unbox_array_size()
return unbox_array_size_slow(); return unbox_array_size_slow();
} }
VM_C_API void box_float(float flo, factor_vm *vm); VM_C_API cell from_float(float flo, factor_vm *vm);
VM_C_API float to_float(cell value, factor_vm *vm); VM_C_API float to_float(cell value, factor_vm *vm);
VM_C_API void box_double(double flo, factor_vm *vm); VM_C_API cell from_double(double flo, factor_vm *vm);
VM_C_API double to_double(cell value, factor_vm *vm); VM_C_API double to_double(cell value, factor_vm *vm);
VM_C_API void box_signed_1(s8 n, factor_vm *vm); VM_C_API cell from_signed_1(s8 n, factor_vm *vm);
VM_C_API void box_unsigned_1(u8 n, factor_vm *vm); VM_C_API cell from_unsigned_1(u8 n, factor_vm *vm);
VM_C_API void box_signed_2(s16 n, factor_vm *vm); VM_C_API cell from_signed_2(s16 n, factor_vm *vm);
VM_C_API void box_unsigned_2(u16 n, factor_vm *vm); VM_C_API cell from_unsigned_2(u16 n, factor_vm *vm);
VM_C_API void box_signed_4(s32 n, factor_vm *vm); VM_C_API cell from_signed_4(s32 n, factor_vm *vm);
VM_C_API void box_unsigned_4(u32 n, factor_vm *vm); VM_C_API cell from_unsigned_4(u32 n, factor_vm *vm);
VM_C_API void box_signed_cell(fixnum integer, factor_vm *vm); VM_C_API cell from_signed_cell(fixnum integer, factor_vm *vm);
VM_C_API void box_unsigned_cell(cell cell, factor_vm *vm); VM_C_API cell from_unsigned_cell(cell integer, factor_vm *vm);
VM_C_API void box_signed_8(s64 n, factor_vm *vm); VM_C_API cell from_signed_8(s64 n, factor_vm *vm);
VM_C_API void box_unsigned_8(u64 n, factor_vm *vm); VM_C_API cell from_unsigned_8(u64 n, factor_vm *vm);
VM_C_API s64 to_signed_8(cell obj, factor_vm *vm); VM_C_API s64 to_signed_8(cell obj, factor_vm *vm);
VM_C_API u64 to_unsigned_8(cell obj, factor_vm *vm); VM_C_API u64 to_unsigned_8(cell obj, factor_vm *vm);
@ -96,8 +96,8 @@ VM_C_API u64 to_unsigned_8(cell obj, factor_vm *vm);
VM_C_API fixnum to_fixnum(cell tagged, factor_vm *vm); VM_C_API fixnum to_fixnum(cell tagged, factor_vm *vm);
VM_C_API cell to_cell(cell tagged, factor_vm *vm); VM_C_API cell to_cell(cell tagged, factor_vm *vm);
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *vm); VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *parent);
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *vm); VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *parent);
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *vm); VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *parent);
} }

28
vm/objects.cpp
View File

@ -5,22 +5,22 @@ namespace factor
void factor_vm::primitive_special_object() void factor_vm::primitive_special_object()
{ {
fixnum e = untag_fixnum(dpeek()); fixnum e = untag_fixnum(ctx->peek());
drepl(special_objects[e]); ctx->replace(special_objects[e]);
} }
void factor_vm::primitive_set_special_object() void factor_vm::primitive_set_special_object()
{ {
fixnum e = untag_fixnum(dpop()); fixnum e = untag_fixnum(ctx->pop());
cell value = dpop(); cell value = ctx->pop();
special_objects[e] = value; special_objects[e] = value;
} }
void factor_vm::primitive_identity_hashcode() void factor_vm::primitive_identity_hashcode()
{ {
cell tagged = dpeek(); cell tagged = ctx->peek();
object *obj = untag<object>(tagged); object *obj = untag<object>(tagged);
drepl(tag_fixnum(obj->hashcode())); ctx->replace(tag_fixnum(obj->hashcode()));
} }
void factor_vm::compute_identity_hashcode(object *obj) void factor_vm::compute_identity_hashcode(object *obj)
@ -32,15 +32,15 @@ void factor_vm::compute_identity_hashcode(object *obj)
void factor_vm::primitive_compute_identity_hashcode() void factor_vm::primitive_compute_identity_hashcode()
{ {
object *obj = untag<object>(dpop()); object *obj = untag<object>(ctx->pop());
compute_identity_hashcode(obj); compute_identity_hashcode(obj);
} }
void factor_vm::primitive_set_slot() void factor_vm::primitive_set_slot()
{ {
fixnum slot = untag_fixnum(dpop()); fixnum slot = untag_fixnum(ctx->pop());
object *obj = untag<object>(dpop()); object *obj = untag<object>(ctx->pop());
cell value = dpop(); cell value = ctx->pop();
cell *slot_ptr = &obj->slots()[slot]; cell *slot_ptr = &obj->slots()[slot];
*slot_ptr = value; *slot_ptr = value;
@ -65,7 +65,7 @@ cell factor_vm::clone_object(cell obj_)
void factor_vm::primitive_clone() void factor_vm::primitive_clone()
{ {
drepl(clone_object(dpeek())); ctx->replace(clone_object(ctx->peek()));
} }
/* Size of the object pointed to by a tagged pointer */ /* Size of the object pointed to by a tagged pointer */
@ -79,7 +79,7 @@ cell factor_vm::object_size(cell tagged)
void factor_vm::primitive_size() void factor_vm::primitive_size()
{ {
box_unsigned_cell(object_size(dpop())); ctx->push(allot_cell(object_size(ctx->pop())));
} }
struct slot_become_visitor { struct slot_become_visitor {
@ -114,8 +114,8 @@ struct object_become_visitor {
to coalesce equal but distinct quotations and wrappers. */ to coalesce equal but distinct quotations and wrappers. */
void factor_vm::primitive_become() void factor_vm::primitive_become()
{ {
array *new_objects = untag_check<array>(dpop()); array *new_objects = untag_check<array>(ctx->pop());
array *old_objects = untag_check<array>(dpop()); array *old_objects = untag_check<array>(ctx->pop());
cell capacity = array_capacity(new_objects); cell capacity = array_capacity(new_objects);
if(capacity != array_capacity(old_objects)) if(capacity != array_capacity(old_objects))

4
vm/os-macosx.mm
View File

@ -14,12 +14,12 @@ NS_DURING
c_to_factor(quot,this); c_to_factor(quot,this);
NS_VOIDRETURN; NS_VOIDRETURN;
NS_HANDLER NS_HANDLER
dpush(allot_alien(false_object,(cell)localException)); ctx->push(allot_alien(false_object,(cell)localException));
quot = special_objects[OBJ_COCOA_EXCEPTION]; quot = special_objects[OBJ_COCOA_EXCEPTION];
if(!tagged<object>(quot).type_p(QUOTATION_TYPE)) if(!tagged<object>(quot).type_p(QUOTATION_TYPE))
{ {
/* No Cocoa exception handler was registered, so /* No Cocoa exception handler was registered, so
extra/cocoa/ is not loaded. So we pass the exception basis/cocoa/ is not loaded. So we pass the exception
along. */ along. */
[localException raise]; [localException raise];
} }

4
vm/os-unix.cpp
View File

@ -92,8 +92,8 @@ void factor_vm::ffi_dlclose(dll *dll)
void factor_vm::primitive_existsp() void factor_vm::primitive_existsp()
{ {
struct stat sb; struct stat sb;
char *path = (char *)(untag_check<byte_array>(dpop()) + 1); char *path = (char *)(untag_check<byte_array>(ctx->pop()) + 1);
box_boolean(stat(path,&sb) >= 0); ctx->push(tag_boolean(stat(path,&sb) >= 0));
} }
segment::segment(cell size_, bool executable_p) segment::segment(cell size_, bool executable_p)

4
vm/os-windows.cpp
View File

@ -92,8 +92,8 @@ const vm_char *factor_vm::vm_executable_path()
void factor_vm::primitive_existsp() void factor_vm::primitive_existsp()
{ {
vm_char *path = untag_check<byte_array>(dpop())->data<vm_char>(); vm_char *path = untag_check<byte_array>(ctx->pop())->data<vm_char>();
box_boolean(windows_stat(path)); ctx->push(tag_boolean(windows_stat(path)));
} }
segment::segment(cell size_, bool executable_p) segment::segment(cell size_, bool executable_p)

27
vm/primitives.hpp
View File

@ -1,29 +1,14 @@
namespace factor namespace factor
{ {
#if defined(FACTOR_X86) extern "C" typedef void (*primitive_type)(factor_vm *parent);
extern "C" __attribute__ ((regparm (1))) typedef void (*primitive_type)(factor_vm *parent); #define PRIMITIVE(name) extern "C" void primitive_##name(factor_vm *parent)
#define PRIMITIVE(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(factor_vm *parent) #define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(factor_vm *parent) \
#define PRIMITIVE_FORWARD(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(factor_vm *parent) \ { \
{ \
parent->primitive_##name(); \ parent->primitive_##name(); \
} }
#else
extern "C" typedef void (*primitive_type)(factor_vm *parent);
#define PRIMITIVE(name) extern "C" void primitive_##name(factor_vm *parent)
#define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(factor_vm *parent) \
{ \
parent->primitive_##name(); \
}
#endif
extern const primitive_type primitives[];
/* These are defined in assembly */ extern const primitive_type primitives[];
PRIMITIVE(fixnum_add);
PRIMITIVE(fixnum_subtract);
PRIMITIVE(fixnum_multiply);
PRIMITIVE(inline_cache_miss);
PRIMITIVE(inline_cache_miss_tail);
/* These are generated with macros in alien.c */ /* These are generated with macros in alien.c */
PRIMITIVE(alien_signed_cell); PRIMITIVE(alien_signed_cell);

2
vm/profiler.cpp
View File

@ -60,7 +60,7 @@ void factor_vm::set_profiling(bool profiling)
void factor_vm::primitive_profiling() void factor_vm::primitive_profiling()
{ {
set_profiling(to_boolean(dpop())); set_profiling(to_boolean(ctx->pop()));
} }
} }

21
vm/quotations.cpp
View File

@ -297,25 +297,25 @@ void factor_vm::jit_compile_quot(cell quot_, bool relocating)
void factor_vm::primitive_jit_compile() void factor_vm::primitive_jit_compile()
{ {
jit_compile_quot(dpop(),true); jit_compile_quot(ctx->pop(),true);
} }
/* push a new quotation on the stack */ /* push a new quotation on the stack */
void factor_vm::primitive_array_to_quotation() void factor_vm::primitive_array_to_quotation()
{ {
quotation *quot = allot<quotation>(sizeof(quotation)); quotation *quot = allot<quotation>(sizeof(quotation));
quot->array = dpeek(); quot->array = ctx->peek();
quot->cached_effect = false_object; quot->cached_effect = false_object;
quot->cache_counter = false_object; quot->cache_counter = false_object;
quot->xt = (void *)lazy_jit_compile; quot->xt = (void *)lazy_jit_compile;
quot->code = NULL; quot->code = NULL;
drepl(tag<quotation>(quot)); ctx->replace(tag<quotation>(quot));
} }
void factor_vm::primitive_quotation_xt() void factor_vm::primitive_quotation_xt()
{ {
quotation *quot = untag_check<quotation>(dpeek()); quotation *quot = untag_check<quotation>(ctx->peek());
drepl(allot_cell((cell)quot->xt)); ctx->replace(allot_cell((cell)quot->xt));
} }
/* Allocates memory */ /* Allocates memory */
@ -332,24 +332,23 @@ fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset)
return compiler.get_position(); return compiler.get_position();
} }
cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack) cell factor_vm::lazy_jit_compile_impl(cell quot_)
{ {
data_root<quotation> quot(quot_,this); data_root<quotation> quot(quot_,this);
ctx->callstack_top = stack;
jit_compile_quot(quot.value(),true); jit_compile_quot(quot.value(),true);
return quot.value(); return quot.value();
} }
VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *parent) VM_C_API cell lazy_jit_compile_impl(cell quot, factor_vm *parent)
{ {
return parent->lazy_jit_compile_impl(quot_,stack); return parent->lazy_jit_compile_impl(quot);
} }
void factor_vm::primitive_quot_compiled_p() void factor_vm::primitive_quot_compiled_p()
{ {
tagged<quotation> quot(dpop()); tagged<quotation> quot(ctx->pop());
quot.untag_check(this); quot.untag_check(this);
dpush(tag_boolean(quot->code != NULL)); ctx->push(tag_boolean(quot->code != NULL));
} }
} }

2
vm/quotations.hpp
View File

@ -27,6 +27,6 @@ struct quotation_jit : public jit {
void iterate_quotation(); void iterate_quotation();
}; };
VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *parent); VM_C_API cell lazy_jit_compile_impl(cell quot, factor_vm *parent);
} }

8
vm/run.cpp
View File

@ -5,12 +5,12 @@ namespace factor
void factor_vm::primitive_exit() void factor_vm::primitive_exit()
{ {
exit(to_fixnum(dpop())); exit(to_fixnum(ctx->pop()));
} }
void factor_vm::primitive_system_micros() void factor_vm::primitive_system_micros()
{ {
box_unsigned_8(system_micros()); ctx->push(from_unsigned_8(system_micros()));
} }
void factor_vm::primitive_nano_count() void factor_vm::primitive_nano_count()
@ -18,12 +18,12 @@ void factor_vm::primitive_nano_count()
u64 nanos = nano_count(); u64 nanos = nano_count();
if(nanos < last_nano_count) critical_error("Monotonic counter decreased",0); if(nanos < last_nano_count) critical_error("Monotonic counter decreased",0);
last_nano_count = nanos; last_nano_count = nanos;
box_unsigned_8(nanos); ctx->push(from_unsigned_8(nanos));
} }
void factor_vm::primitive_sleep() void factor_vm::primitive_sleep()
{ {
sleep_nanos(to_unsigned_8(dpop())); sleep_nanos(to_unsigned_8(ctx->pop()));
} }
} }

26
vm/strings.cpp
View File

@ -101,9 +101,9 @@ string *factor_vm::allot_string(cell capacity, cell fill)
void factor_vm::primitive_string() void factor_vm::primitive_string()
{ {
cell initial = to_cell(dpop()); cell initial = to_cell(ctx->pop());
cell length = unbox_array_size(); cell length = unbox_array_size();
dpush(tag<string>(allot_string(length,initial))); ctx->push(tag<string>(allot_string(length,initial)));
} }
bool factor_vm::reallot_string_in_place_p(string *str, cell capacity) bool factor_vm::reallot_string_in_place_p(string *str, cell capacity)
@ -157,32 +157,32 @@ string* factor_vm::reallot_string(string *str_, cell capacity)
void factor_vm::primitive_resize_string() void factor_vm::primitive_resize_string()
{ {
data_root<string> str(dpop(),this); data_root<string> str(ctx->pop(),this);
str.untag_check(this); str.untag_check(this);
cell capacity = unbox_array_size(); cell capacity = unbox_array_size();
dpush(tag<string>(reallot_string(str.untagged(),capacity))); ctx->push(tag<string>(reallot_string(str.untagged(),capacity)));
} }
void factor_vm::primitive_string_nth() void factor_vm::primitive_string_nth()
{ {
string *str = untag<string>(dpop()); string *str = untag<string>(ctx->pop());
cell index = untag_fixnum(dpop()); cell index = untag_fixnum(ctx->pop());
dpush(tag_fixnum(str->nth(index))); ctx->push(tag_fixnum(str->nth(index)));
} }
void factor_vm::primitive_set_string_nth_fast() void factor_vm::primitive_set_string_nth_fast()
{ {
string *str = untag<string>(dpop()); string *str = untag<string>(ctx->pop());
cell index = untag_fixnum(dpop()); cell index = untag_fixnum(ctx->pop());
cell value = untag_fixnum(dpop()); cell value = untag_fixnum(ctx->pop());
set_string_nth_fast(str,index,value); set_string_nth_fast(str,index,value);
} }
void factor_vm::primitive_set_string_nth_slow() void factor_vm::primitive_set_string_nth_slow()
{ {
string *str = untag<string>(dpop()); string *str = untag<string>(ctx->pop());
cell index = untag_fixnum(dpop()); cell index = untag_fixnum(ctx->pop());
cell value = untag_fixnum(dpop()); cell value = untag_fixnum(ctx->pop());
set_string_nth_slow(str,index,value); set_string_nth_slow(str,index,value);
} }

12
vm/tuples.cpp
View File

@ -6,27 +6,27 @@ namespace factor
/* push a new tuple on the stack, filling its slots with f */ /* push a new tuple on the stack, filling its slots with f */
void factor_vm::primitive_tuple() void factor_vm::primitive_tuple()
{ {
data_root<tuple_layout> layout(dpop(),this); data_root<tuple_layout> layout(ctx->pop(),this);
tagged<tuple> t(allot<tuple>(tuple_size(layout.untagged()))); tagged<tuple> t(allot<tuple>(tuple_size(layout.untagged())));
t->layout = layout.value(); t->layout = layout.value();
memset_cell(t->data(),false_object,tuple_size(layout.untagged()) - sizeof(cell)); memset_cell(t->data(),false_object,tuple_size(layout.untagged()) - sizeof(cell));
dpush(t.value()); ctx->push(t.value());
} }
/* push a new tuple on the stack, filling its slots from the stack */ /* push a new tuple on the stack, filling its slots from the stack */
void factor_vm::primitive_tuple_boa() void factor_vm::primitive_tuple_boa()
{ {
data_root<tuple_layout> layout(dpop(),this); data_root<tuple_layout> layout(ctx->pop(),this);
tagged<tuple> t(allot<tuple>(tuple_size(layout.untagged()))); tagged<tuple> t(allot<tuple>(tuple_size(layout.untagged())));
t->layout = layout.value(); t->layout = layout.value();
cell size = untag_fixnum(layout.untagged()->size) * sizeof(cell); cell size = untag_fixnum(layout.untagged()->size) * sizeof(cell);
memcpy(t->data(),(cell *)(ds - size + sizeof(cell)),size); memcpy(t->data(),(cell *)(ctx->datastack - size + sizeof(cell)),size);
ds -= size; ctx->datastack -= size;
dpush(t.value()); ctx->push(t.value());
} }
} }

37
vm/vm.hpp
View File

@ -92,10 +92,6 @@ struct factor_vm
u64 last_nano_count; u64 last_nano_count;
// contexts // contexts
void reset_datastack();
void reset_retainstack();
void fix_stacks();
void save_stacks();
context *alloc_context(); context *alloc_context();
void dealloc_context(context *old_context); void dealloc_context(context *old_context);
void nest_stacks(stack_frame *magic_frame); void nest_stacks(stack_frame *magic_frame);
@ -375,9 +371,7 @@ struct factor_vm
void primitive_set_string_nth_slow(); void primitive_set_string_nth_slow();
//booleans //booleans
void box_boolean(bool value); cell tag_boolean(cell untagged)
inline cell tag_boolean(cell untagged)
{ {
return (untagged ? true_object : false_object); return (untagged ? true_object : false_object);
} }
@ -462,21 +456,19 @@ struct factor_vm
void primitive_bits_double(); void primitive_bits_double();
fixnum to_fixnum(cell tagged); fixnum to_fixnum(cell tagged);
cell to_cell(cell tagged); cell to_cell(cell tagged);
void box_signed_1(s8 n); cell from_signed_1(s8 n);
void box_unsigned_1(u8 n); cell from_unsigned_1(u8 n);
void box_signed_2(s16 n); cell from_signed_2(s16 n);
void box_unsigned_2(u16 n); cell from_unsigned_2(u16 n);
void box_signed_4(s32 n); cell from_signed_4(s32 n);
void box_unsigned_4(u32 n); cell from_unsigned_4(u32 n);
void box_signed_cell(fixnum integer); cell from_signed_cell(fixnum integer);
void box_unsigned_cell(cell cell); cell from_unsigned_cell(cell integer);
void box_signed_8(s64 n); cell from_signed_8(s64 n);
s64 to_signed_8(cell obj); s64 to_signed_8(cell obj);
void box_unsigned_8(u64 n); cell from_unsigned_8(u64 n);
u64 to_unsigned_8(cell obj); u64 to_unsigned_8(cell obj);
void box_float(float flo);
float to_float(cell value); float to_float(cell value);
void box_double(double flo);
double to_double(cell value); double to_double(cell value);
inline void overflow_fixnum_add(fixnum x, fixnum y); inline void overflow_fixnum_add(fixnum x, fixnum y);
inline void overflow_fixnum_subtract(fixnum x, fixnum y); inline void overflow_fixnum_subtract(fixnum x, fixnum y);
@ -498,6 +490,7 @@ struct factor_vm
void init_c_io(); void init_c_io();
void io_error(); void io_error();
void primitive_fopen(); void primitive_fopen();
FILE *pop_file_handle();
void primitive_fgetc(); void primitive_fgetc();
void primitive_fread(); void primitive_fread();
void primitive_fputc(); void primitive_fputc();
@ -582,12 +575,12 @@ struct factor_vm
void primitive_innermost_stack_frame_executing(); void primitive_innermost_stack_frame_executing();
void primitive_innermost_stack_frame_scan(); void primitive_innermost_stack_frame_scan();
void primitive_set_innermost_stack_frame_quot(); void primitive_set_innermost_stack_frame_quot();
void save_callstack_bottom(stack_frame *callstack_bottom);
template<typename Iterator> void iterate_callstack(context *ctx, Iterator &iterator); template<typename Iterator> void iterate_callstack(context *ctx, Iterator &iterator);
//alien //alien
char *pinned_alien_offset(cell obj); char *pinned_alien_offset(cell obj);
cell allot_alien(cell delegate_, cell displacement); cell allot_alien(cell delegate_, cell displacement);
cell allot_alien(void *address);
void primitive_displaced_alien(); void primitive_displaced_alien();
void primitive_alien_address(); void primitive_alien_address();
void *alien_pointer(); void *alien_pointer();
@ -597,8 +590,6 @@ struct factor_vm
void primitive_dll_validp(); void primitive_dll_validp();
void primitive_vm_ptr(); void primitive_vm_ptr();
char *alien_offset(cell obj); char *alien_offset(cell obj);
char *unbox_alien();
void box_alien(void *ptr);
void to_value_struct(cell src, void *dest, cell size); void to_value_struct(cell src, void *dest, cell size);
void box_value_struct(void *src, cell size); void box_value_struct(void *src, cell size);
void box_small_struct(cell x, cell y, cell size); void box_small_struct(cell x, cell y, cell size);
@ -612,7 +603,7 @@ struct factor_vm
code_block *jit_compile_quot(cell owner_, cell quot_, bool relocating); code_block *jit_compile_quot(cell owner_, cell quot_, bool relocating);
void jit_compile_quot(cell quot_, bool relocating); void jit_compile_quot(cell quot_, bool relocating);
fixnum quot_code_offset_to_scan(cell quot_, cell offset); fixnum quot_code_offset_to_scan(cell quot_, cell offset);
cell lazy_jit_compile_impl(cell quot_, stack_frame *stack); cell lazy_jit_compile_impl(cell quot);
void primitive_quot_compiled_p(); void primitive_quot_compiled_p();
//dispatch //dispatch

26
vm/words.cpp
View File

@ -73,27 +73,27 @@ word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_)
/* (word) ( name vocabulary hashcode -- word ) */ /* (word) ( name vocabulary hashcode -- word ) */
void factor_vm::primitive_word() void factor_vm::primitive_word()
{ {
cell hashcode = dpop(); cell hashcode = ctx->pop();
cell vocab = dpop(); cell vocab = ctx->pop();
cell name = dpop(); cell name = ctx->pop();
dpush(tag<word>(allot_word(name,vocab,hashcode))); ctx->push(tag<word>(allot_word(name,vocab,hashcode)));
} }
/* word-xt ( word -- start end ) */ /* word-xt ( word -- start end ) */
void factor_vm::primitive_word_xt() void factor_vm::primitive_word_xt()
{ {
data_root<word> w(dpop(),this); data_root<word> w(ctx->pop(),this);
w.untag_check(this); w.untag_check(this);
if(profiling_p) if(profiling_p)
{ {
dpush(allot_cell((cell)w->profiling->xt())); ctx->push(allot_cell((cell)w->profiling->xt()));
dpush(allot_cell((cell)w->profiling + w->profiling->size())); ctx->push(allot_cell((cell)w->profiling + w->profiling->size()));
} }
else else
{ {
dpush(allot_cell((cell)w->code->xt())); ctx->push(allot_cell((cell)w->code->xt()));
dpush(allot_cell((cell)w->code + w->code->size())); ctx->push(allot_cell((cell)w->code + w->code->size()));
} }
} }
@ -107,15 +107,15 @@ void factor_vm::update_word_xt(word *w)
void factor_vm::primitive_optimized_p() void factor_vm::primitive_optimized_p()
{ {
word *w = untag_check<word>(dpeek()); word *w = untag_check<word>(ctx->peek());
drepl(tag_boolean(w->code->optimized_p())); ctx->replace(tag_boolean(w->code->optimized_p()));
} }
void factor_vm::primitive_wrapper() void factor_vm::primitive_wrapper()
{ {
wrapper *new_wrapper = allot<wrapper>(sizeof(wrapper)); wrapper *new_wrapper = allot<wrapper>(sizeof(wrapper));
new_wrapper->object = dpeek(); new_wrapper->object = ctx->peek();
drepl(tag<wrapper>(new_wrapper)); ctx->replace(tag<wrapper>(new_wrapper));
} }
} }