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

Merge branch 'vm_cleanup' of git://github.com/phildawes/factor

db4
Slava Pestov 2009-09-25 19:04:19 -05:00
parent ed37950a33 6b7717bf37
commit d017a53227
40 changed files with 229 additions and 582 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/compiler/codegen/codegen.factor
View File

@ -271,7 +271,7 @@ M: _gc generate-insn
[ data-values>> save-data-regs ]
[ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ]
[ [ temp1>> ] [ temp2>> ] bi t %save-context ]
[ tagged-values>> length %call-gc ]
[ [ tagged-values>> length ] [ temp1>> ] bi %call-gc ]
[ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
[ data-values>> load-data-regs ]
} cleave
@ -447,7 +447,7 @@ M: ##alien-indirect generate-insn
! Generate code for boxing input parameters in a callback.
[
dup \ %save-param-reg move-parameters
"nest_stacks" %vm-invoke-1st-arg
%nest-stacks
box-parameters
] with-param-regs ;
@ -485,8 +485,6 @@ TUPLE: callback-context ;
[ callback-context new do-callback ] %
] [ ] make ;
: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke-1st-arg ;
M: ##callback-return generate-insn
#! All the extra book-keeping for %unwind is only for x86.
#! On other platforms its an alias for %return.

9
basis/cpu/architecture/architecture.factor
View File

@ -296,7 +296,7 @@ HOOK: %write-barrier cpu ( src card# table -- )
HOOK: %check-nursery cpu ( label temp1 temp2 -- )
HOOK: %save-gc-root cpu ( gc-root register -- )
HOOK: %load-gc-root cpu ( gc-root register -- )
HOOK: %call-gc cpu ( gc-root-count -- )
HOOK: %call-gc cpu ( gc-root-count temp1 -- )
HOOK: %prologue cpu ( n -- )
HOOK: %epilogue cpu ( n -- )
@ -383,9 +383,6 @@ M: object %prepare-var-args ;
HOOK: %alien-invoke cpu ( function library -- )
HOOK: %vm-invoke-1st-arg cpu ( function -- )
HOOK: %vm-invoke-3rd-arg cpu ( function -- )
HOOK: %cleanup cpu ( params -- )
M: object %cleanup ( params -- ) drop ;
@ -398,6 +395,10 @@ HOOK: %alien-callback cpu ( quot -- )
HOOK: %callback-value cpu ( ctype -- )
HOOK: %nest-stacks cpu ( -- )
HOOK: %unnest-stacks cpu ( -- )
! Return to caller with stdcall unwinding (only for x86)
HOOK: %callback-return cpu ( params -- )

9
basis/cpu/ppc/ppc.factor
View File

@ -40,9 +40,6 @@ enable-float-intrinsics
M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
M: ppc %vm-invoke-1st-arg ( function -- ) f %alien-invoke ;
M: ppc %vm-invoke-3rd-arg ( function -- ) f %alien-invoke ;
M: ppc machine-registers
{
{ int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
@ -781,6 +778,12 @@ M: ppc %box-small-struct ( c-type -- )
4 3 4 LWZ
3 3 0 LWZ ;
M: ppc %nest-stacks ( -- )
"nest_stacks" f %alien-invoke ;
M: ppc %unnest-stacks ( -- )
"unnest_stacks" f %alien-invoke ;
M: ppc %unbox-small-struct ( size -- )
#! Alien must be in EAX.
heap-size cell align cell /i {

42
basis/cpu/x86/32/32.factor
View File

@ -38,9 +38,8 @@ M:: x86.32 %dispatch ( src temp -- )
bi ;
! Registers for fastcall
M: x86.32 param-reg-1 EAX ;
M: x86.32 param-reg-2 EDX ;
M: x86.32 param-reg-3 ECX ;
: param-reg-1 ( -- reg ) EAX ;
: param-reg-2 ( -- reg ) EDX ;
M: x86.32 pic-tail-reg EBX ;
@ -49,16 +48,7 @@ M: x86.32 reserved-area-size 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
: push-vm-ptr ( -- )
temp-reg 0 MOV rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
temp-reg PUSH ;
M: x86.32 %vm-invoke-1st-arg ( function -- )
push-vm-ptr
f %alien-invoke
temp-reg POP ;
M: x86.32 %vm-invoke-3rd-arg ( function -- )
%vm-invoke-1st-arg ; ! first 2 args are regs, 3rd is stack so vm-invoke-1st-arg works here
0 PUSH rc-absolute-cell rt-vm rel-fixup ; ! push the vm ptr as an argument
M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type
@ -247,6 +237,18 @@ M:: x86.32 %unbox-large-struct ( n c-type -- )
"to_value_struct" f %alien-invoke
] with-aligned-stack ;
M: x86.32 %nest-stacks ( -- )
4 [
push-vm-ptr
"nest_stacks" f %alien-invoke
] with-aligned-stack ;
M: x86.32 %unnest-stacks ( -- )
4 [
push-vm-ptr
"unnest_stacks" f %alien-invoke
] with-aligned-stack ;
M: x86.32 %prepare-alien-indirect ( -- )
push-vm-ptr "unbox_alien" f %alien-invoke
temp-reg POP
@ -280,6 +282,7 @@ M: x86.32 %callback-value ( ctype -- )
! Unbox EAX
unbox-return ;
M: x86.32 %cleanup ( params -- )
#! a) If we just called an stdcall function in Windows, it
#! cleaned up the stack frame for us. But we don't want that
@ -311,6 +314,19 @@ M: x86.32 %callback-return ( n -- )
[ drop 0 ]
} cond RET ;
M:: x86.32 %call-gc ( gc-root-count temp1 -- )
! USE: prettyprint "PHIL" pprint temp1 pprint temp2 pprint
temp1 gc-root-base param@ LEA
12 [
0 PUSH rc-absolute-cell rt-vm rel-fixup ! push the vm ptr as an argument
! Pass number of roots as second parameter
gc-root-count PUSH
! Pass pointer to start of GC roots as first parameter
temp1 PUSH
! Call GC
"inline_gc" f %alien-invoke
] with-aligned-stack ;
M: x86.32 dummy-stack-params? f ;
M: x86.32 dummy-int-params? f ;

70
basis/cpu/x86/64/64.factor
View File

@ -36,9 +36,10 @@ M:: x86.64 %dispatch ( src temp -- )
[ align-code ]
bi ;
M: x86.64 param-reg-1 int-regs param-regs first ;
M: x86.64 param-reg-2 int-regs param-regs second ;
M: x86.64 param-reg-3 int-regs param-regs third ;
: param-reg-1 ( -- reg ) int-regs param-regs first ; inline
: param-reg-2 ( -- reg ) int-regs param-regs second ; inline
: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline
M: x86.64 pic-tail-reg RBX ;
@ -74,26 +75,13 @@ M: x86.64 %prepare-unbox ( -- )
param-reg-1 R14 [] MOV
R14 cell SUB ;
M: x86.64 %vm-invoke-1st-arg ( function -- )
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
f %alien-invoke ;
: %vm-invoke-2nd-arg ( function -- )
param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup
f %alien-invoke ;
M: x86.64 %vm-invoke-3rd-arg ( function -- )
param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup
f %alien-invoke ;
: %vm-invoke-4th-arg ( function -- )
int-regs param-regs fourth 0 MOV rc-absolute-cell rt-vm rel-fixup
f %alien-invoke ;
: %mov-vm-ptr ( reg -- )
0 MOV rc-absolute-cell rt-vm rel-fixup ;
M:: x86.64 %unbox ( n rep func -- )
param-reg-2 %mov-vm-ptr
! Call the unboxer
func %vm-invoke-2nd-arg
func f %alien-invoke
! Store the return value on the C stack if this is an
! alien-invoke, otherwise leave it the return register if
! this is the end of alien-callback
@ -109,10 +97,10 @@ M: x86.64 %unbox-long-long ( n func -- )
{ float-regs [ float-regs get pop swap MOVSD ] }
} case ;
M: x86.64 %unbox-small-struct ( c-type -- )
! Alien must be in param-reg-1.
"alien_offset" %vm-invoke-2nd-arg
param-reg-2 %mov-vm-ptr
"alien_offset" f %alien-invoke
! Move alien_offset() return value to R11 so that we don't
! clobber it.
R11 RAX MOV
@ -126,8 +114,9 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
param-reg-2 n param@ LEA
! Load structure size into param-reg-3
param-reg-3 c-type heap-size MOV
param-reg-4 %mov-vm-ptr
! Copy the struct to the C stack
"to_value_struct" %vm-invoke-4th-arg ;
"to_value_struct" f %alien-invoke ;
: load-return-value ( rep -- )
[ [ 0 ] dip reg-class-of param-reg ]
@ -143,7 +132,8 @@ M:: x86.64 %box ( n rep func -- )
] [
rep load-return-value
] if
rep int-rep? [ func %vm-invoke-2nd-arg ] [ func %vm-invoke-1st-arg ] if ;
rep int-rep? [ param-reg-2 ] [ param-reg-1 ] if %mov-vm-ptr
func f %alien-invoke ;
M: x86.64 %box-long-long ( n func -- )
[ int-rep ] dip %box ;
@ -163,7 +153,8 @@ M: x86.64 %box-small-struct ( c-type -- )
[ param-reg-3 swap heap-size MOV ] bi
param-reg-1 0 box-struct-field@ MOV
param-reg-2 1 box-struct-field@ MOV
"box_small_struct" %vm-invoke-4th-arg
param-reg-4 %mov-vm-ptr
"box_small_struct" f %alien-invoke
] with-return-regs ;
: struct-return@ ( n -- operand )
@ -174,8 +165,9 @@ M: x86.64 %box-large-struct ( n c-type -- )
param-reg-2 swap heap-size MOV
! Compute destination address
param-reg-1 swap struct-return@ LEA
param-reg-3 %mov-vm-ptr
! Copy the struct from the C stack
"box_value_struct" %vm-invoke-3rd-arg ;
"box_value_struct" f %alien-invoke ;
M: x86.64 %prepare-box-struct ( -- )
! Compute target address for value struct return
@ -190,9 +182,17 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym
R11 CALL ;
M: x86.64 %nest-stacks ( -- )
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
"nest_stacks" f %alien-invoke ;
M: x86.64 %unnest-stacks ( -- )
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
"unnest_stacks" f %alien-invoke ;
M: x86.64 %prepare-alien-indirect ( -- )
"unbox_alien" %vm-invoke-1st-arg
param-reg-1 %mov-vm-ptr
"unbox_alien" f %alien-invoke
RBP RAX MOV ;
M: x86.64 %alien-indirect ( -- )
@ -200,7 +200,8 @@ M: x86.64 %alien-indirect ( -- )
M: x86.64 %alien-callback ( quot -- )
param-reg-1 swap %load-reference
"c_to_factor" %vm-invoke-2nd-arg ;
param-reg-2 %mov-vm-ptr
"c_to_factor" f %alien-invoke ;
M: x86.64 %callback-value ( ctype -- )
! Save top of data stack
@ -208,8 +209,9 @@ M: x86.64 %callback-value ( ctype -- )
! Save top of data stack
RSP 8 SUB
param-reg-1 PUSH
param-reg-1 %mov-vm-ptr
! Restore data/call/retain stacks
"unnest_stacks" %vm-invoke-1st-arg
"unnest_stacks" f %alien-invoke
! Put former top of data stack in param-reg-1
param-reg-1 POP
RSP 8 ADD
@ -233,6 +235,16 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
func f %alien-invoke
dst float-function-return ;
M:: x86.64 %call-gc ( gc-root-count temp1 -- )
! Pass pointer to start of GC roots as first parameter
param-reg-1 gc-root-base param@ LEA
! Pass number of roots as second parameter
param-reg-2 gc-root-count MOV
! Pass vm as third parameter
param-reg-3 %mov-vm-ptr
! Call GC
"inline_gc" f %alien-invoke ;
! The result of reading 4 bytes from memory is a fixnum on
! x86-64.
enable-alien-4-intrinsics

15
basis/cpu/x86/x86.factor
View File

@ -52,11 +52,6 @@ M: x86 stack-frame-size ( stack-frame -- i )
! use in calls in and out of C
HOOK: temp-reg cpu ( -- reg )
! Fastcall calling convention
HOOK: param-reg-1 cpu ( -- reg )
HOOK: param-reg-2 cpu ( -- reg )
HOOK: param-reg-3 cpu ( -- reg )
HOOK: pic-tail-reg cpu ( -- reg )
M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ;
@ -828,16 +823,6 @@ M: x86 %save-gc-root ( gc-root register -- ) [ gc-root@ ] dip MOV ;
M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
M:: x86 %call-gc ( gc-root-count -- )
! Pass pointer to start of GC roots as first parameter
param-reg-1 gc-root-base param@ LEA
! Pass number of roots as second parameter
param-reg-2 gc-root-count MOV
! Pass vm as third argument
param-reg-3 0 MOV rc-absolute-cell rt-vm rel-fixup
! Call GC
"inline_gc" f %alien-invoke ;
M: x86 %alien-global ( dst symbol library -- )
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;

35
vm/alien.cpp
View File

@ -69,10 +69,7 @@ inline void factor_vm::primitive_displaced_alien()
}
}
PRIMITIVE(displaced_alien)
{
PRIMITIVE_GETVM()->primitive_displaced_alien();
}
PRIMITIVE_FORWARD(displaced_alien)
/* address of an object representing a C pointer. Explicitly throw an error
if the object is a byte array, as a sanity check. */
@ -81,10 +78,7 @@ inline void factor_vm::primitive_alien_address()
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
}
PRIMITIVE(alien_address)
{
PRIMITIVE_GETVM()->primitive_alien_address();
}
PRIMITIVE_FORWARD(alien_address)
/* pop ( alien n ) from datastack, return alien's address plus n */
void *factor_vm::alien_pointer()
@ -131,10 +125,7 @@ inline void factor_vm::primitive_dlopen()
dpush(library.value());
}
PRIMITIVE(dlopen)
{
PRIMITIVE_GETVM()->primitive_dlopen();
}
PRIMITIVE_FORWARD(dlopen)
/* look up a symbol in a native library */
inline void factor_vm::primitive_dlsym()
@ -158,10 +149,7 @@ inline void factor_vm::primitive_dlsym()
}
}
PRIMITIVE(dlsym)
{
PRIMITIVE_GETVM()->primitive_dlsym();
}
PRIMITIVE_FORWARD(dlsym)
/* close a native library handle */
inline void factor_vm::primitive_dlclose()
@ -171,10 +159,7 @@ inline void factor_vm::primitive_dlclose()
ffi_dlclose(d);
}
PRIMITIVE(dlclose)
{
PRIMITIVE_GETVM()->primitive_dlclose();
}
PRIMITIVE_FORWARD(dlclose)
inline void factor_vm::primitive_dll_validp()
{
@ -185,10 +170,7 @@ inline void factor_vm::primitive_dll_validp()
dpush(untag_check<dll>(library)->dll == NULL ? F : T);
}
PRIMITIVE(dll_validp)
{
PRIMITIVE_GETVM()->primitive_dll_validp();
}
PRIMITIVE_FORWARD(dll_validp)
/* gets the address of an object representing a C pointer */
char *factor_vm::alien_offset(cell obj)
@ -308,9 +290,6 @@ inline void factor_vm::primitive_vm_ptr()
box_alien(this);
}
PRIMITIVE(vm_ptr)
{
PRIMITIVE_GETVM()->primitive_vm_ptr();
}
PRIMITIVE_FORWARD(vm_ptr)
}

10
vm/arrays.cpp
View File

@ -31,10 +31,7 @@ inline void factor_vm::primitive_array()
dpush(tag<array>(allot_array(size,initial)));
}
PRIMITIVE(array)
{
PRIMITIVE_GETVM()->primitive_array();
}
PRIMITIVE_FORWARD(array)
cell factor_vm::allot_array_1(cell obj_)
{
@ -75,10 +72,7 @@ inline void factor_vm::primitive_resize_array()
dpush(tag<array>(reallot_array(a,capacity)));
}
PRIMITIVE(resize_array)
{
PRIMITIVE_GETVM()->primitive_resize_array();
}
PRIMITIVE_FORWARD(resize_array)
void growable_array::add(cell elt_)
{

15
vm/byte_arrays.cpp
View File

@ -16,10 +16,7 @@ inline void factor_vm::primitive_byte_array()
dpush(tag<byte_array>(allot_byte_array(size)));
}
PRIMITIVE(byte_array)
{
PRIMITIVE_GETVM()->primitive_byte_array();
}
PRIMITIVE_FORWARD(byte_array)
inline void factor_vm::primitive_uninitialized_byte_array()
{
@ -27,10 +24,7 @@ inline void factor_vm::primitive_uninitialized_byte_array()
dpush(tag<byte_array>(allot_array_internal<byte_array>(size)));
}
PRIMITIVE(uninitialized_byte_array)
{
PRIMITIVE_GETVM()->primitive_uninitialized_byte_array();
}
PRIMITIVE_FORWARD(uninitialized_byte_array)
inline void factor_vm::primitive_resize_byte_array()
{
@ -39,10 +33,7 @@ inline void factor_vm::primitive_resize_byte_array()
dpush(tag<byte_array>(reallot_array(array,capacity)));
}
PRIMITIVE(resize_byte_array)
{
PRIMITIVE_GETVM()->primitive_resize_byte_array();
}
PRIMITIVE_FORWARD(resize_byte_array)
void growable_byte_array::append_bytes(void *elts, cell len)
{

30
vm/callstack.cpp
View File

@ -60,10 +60,7 @@ inline void factor_vm::primitive_callstack()
dpush(tag<callstack>(stack));
}
PRIMITIVE(callstack)
{
PRIMITIVE_GETVM()->primitive_callstack();
}
PRIMITIVE_FORWARD(callstack)
inline void factor_vm::primitive_set_callstack()
{
@ -78,10 +75,7 @@ inline void factor_vm::primitive_set_callstack()
critical_error("Bug in set_callstack()",0);
}
PRIMITIVE(set_callstack)
{
PRIMITIVE_GETVM()->primitive_set_callstack();
}
PRIMITIVE_FORWARD(set_callstack)
code_block *factor_vm::frame_code(stack_frame *frame)
{
@ -172,10 +166,7 @@ inline void factor_vm::primitive_callstack_to_array()
dpush(accum.frames.elements.value());
}
PRIMITIVE(callstack_to_array)
{
PRIMITIVE_GETVM()->primitive_callstack_to_array();
}
PRIMITIVE_FORWARD(callstack_to_array)
stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
{
@ -203,20 +194,14 @@ inline void factor_vm::primitive_innermost_stack_frame_executing()
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
}
PRIMITIVE(innermost_stack_frame_executing)
{
PRIMITIVE_GETVM()->primitive_innermost_stack_frame_executing();
}
PRIMITIVE_FORWARD(innermost_stack_frame_executing)
inline void factor_vm::primitive_innermost_stack_frame_scan()
{
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
}
PRIMITIVE(innermost_stack_frame_scan)
{
PRIMITIVE_GETVM()->primitive_innermost_stack_frame_scan();
}
PRIMITIVE_FORWARD(innermost_stack_frame_scan)
inline void factor_vm::primitive_set_innermost_stack_frame_quot()
{
@ -234,10 +219,7 @@ inline void factor_vm::primitive_set_innermost_stack_frame_quot()
FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
}
PRIMITIVE(set_innermost_stack_frame_quot)
{
PRIMITIVE_GETVM()->primitive_set_innermost_stack_frame_quot();
}
PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
/* called before entry into Factor code. */
void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)

2
vm/callstack.hpp
View File

@ -13,7 +13,7 @@ PRIMITIVE(innermost_stack_frame_executing);
PRIMITIVE(innermost_stack_frame_scan);
PRIMITIVE(set_innermost_stack_frame_quot);
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom,factor_vm *vm);
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *vm);
}

10
vm/code_heap.cpp
View File

@ -106,10 +106,7 @@ inline void factor_vm::primitive_modify_code_heap()
update_code_heap_words();
}
PRIMITIVE(modify_code_heap)
{
PRIMITIVE_GETVM()->primitive_modify_code_heap();
}
PRIMITIVE_FORWARD(modify_code_heap)
/* Push the free space and total size of the code heap */
inline void factor_vm::primitive_code_room()
@ -122,10 +119,7 @@ inline void factor_vm::primitive_code_room()
dpush(tag_fixnum(max_free / 1024));
}
PRIMITIVE(code_room)
{
PRIMITIVE_GETVM()->primitive_code_room();
}
PRIMITIVE_FORWARD(code_room)
code_block *factor_vm::forward_xt(code_block *compiled)
{

25
vm/contexts.cpp
View File

@ -146,10 +146,7 @@ inline void factor_vm::primitive_datastack()
general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
}
PRIMITIVE(datastack)
{
PRIMITIVE_GETVM()->primitive_datastack();
}
PRIMITIVE_FORWARD(datastack)
inline void factor_vm::primitive_retainstack()
{
@ -157,10 +154,7 @@ inline void factor_vm::primitive_retainstack()
general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
}
PRIMITIVE(retainstack)
{
PRIMITIVE_GETVM()->primitive_retainstack();
}
PRIMITIVE_FORWARD(retainstack)
/* returns pointer to top of stack */
cell factor_vm::array_to_stack(array *array, cell bottom)
@ -175,20 +169,14 @@ inline void factor_vm::primitive_set_datastack()
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
}
PRIMITIVE(set_datastack)
{
PRIMITIVE_GETVM()->primitive_set_datastack();
}
PRIMITIVE_FORWARD(set_datastack)
inline void factor_vm::primitive_set_retainstack()
{
rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
}
PRIMITIVE(set_retainstack)
{
PRIMITIVE_GETVM()->primitive_set_retainstack();
}
PRIMITIVE_FORWARD(set_retainstack)
/* Used to implement call( */
inline void factor_vm::primitive_check_datastack()
@ -216,9 +204,6 @@ inline void factor_vm::primitive_check_datastack()
}
}
PRIMITIVE(check_datastack)
{
PRIMITIVE_GETVM()->primitive_check_datastack();
}
PRIMITIVE_FORWARD(check_datastack)
}

1
vm/cpu-ppc.hpp
View File

@ -3,7 +3,6 @@ namespace factor
#define FACTOR_CPU_STRING "ppc"
#define VM_ASM_API VM_C_API
#define VM_ASM_API_OVERFLOW VM_C_API
register cell ds asm("r13");
register cell rs asm("r14");

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

@ -82,7 +82,7 @@ DEF(void,set_x87_env,(const void*)):
ret
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
mov CELL_SIZE(STACK_REG),NV_TEMP_REG /* get vm ptr in case quot_xt = lazy_jit_compile */
mov ARG2,NV_TEMP_REG /* remember vm ptr in case quot_xt = lazy_jit_compile */
/* clear x87 stack, but preserve rounding mode and exception flags */
sub $2,STACK_REG
fnstcw (STACK_REG)

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

@ -6,6 +6,5 @@ namespace factor
register cell ds asm("esi");
register cell rs asm("edi");
#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))
#define VM_ASM_API_OVERFLOW VM_C_API __attribute__ ((regparm (3)))
#define VM_ASM_API VM_C_API __attribute__ ((regparm (3)))
}

1
vm/cpu-x86.64.hpp
View File

@ -7,5 +7,4 @@ register cell ds asm("r14");
register cell rs asm("r15");
#define VM_ASM_API VM_C_API
#define VM_ASM_API_OVERFLOW VM_C_API
}

2
vm/cpu-x86.hpp
View File

@ -69,7 +69,7 @@ inline static unsigned int fpu_status(unsigned int status)
}
/* 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_ASM_API void lazy_jit_compile(cell quot, void *vm);

22
vm/data_gc.cpp
View File

@ -573,10 +573,7 @@ inline void factor_vm::primitive_gc()
gc();
}
PRIMITIVE(gc)
{
PRIMITIVE_GETVM()->primitive_gc();
}
PRIMITIVE_FORWARD(gc)
inline void factor_vm::primitive_gc_stats()
{
@ -608,10 +605,7 @@ inline void factor_vm::primitive_gc_stats()
dpush(result.elements.value());
}
PRIMITIVE(gc_stats)
{
PRIMITIVE_GETVM()->primitive_gc_stats();
}
PRIMITIVE_FORWARD(gc_stats)
void factor_vm::clear_gc_stats()
{
@ -629,10 +623,7 @@ inline void factor_vm::primitive_clear_gc_stats()
clear_gc_stats();
}
PRIMITIVE(clear_gc_stats)
{
PRIMITIVE_GETVM()->primitive_clear_gc_stats();
}
PRIMITIVE_FORWARD(clear_gc_stats)
/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
to coalesce equal but distinct quotations and wrappers. */
@ -665,10 +656,7 @@ inline void factor_vm::primitive_become()
compile_all_words();
}
PRIMITIVE(become)
{
PRIMITIVE_GETVM()->primitive_become();
}
PRIMITIVE_FORWARD(become)
void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
{
@ -681,7 +669,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
gc_locals.pop_back();
}
VM_ASM_API_OVERFLOW void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm)
VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm)
{
ASSERTVM();
VM_PTR->inline_gc(gc_roots_base,gc_roots_size);

2
vm/data_gc.hpp
View File

@ -20,6 +20,6 @@ PRIMITIVE(gc_stats);
PRIMITIVE(clear_gc_stats);
PRIMITIVE(become);
struct factor_vm;
VM_ASM_API_OVERFLOW void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
}

25
vm/data_heap.cpp
View File

@ -222,10 +222,7 @@ inline void factor_vm::primitive_size()
box_unsigned_cell(object_size(dpop()));
}
PRIMITIVE(size)
{
PRIMITIVE_GETVM()->primitive_size();
}
PRIMITIVE_FORWARD(size)
/* The number of cells from the start of the object which should be scanned by
the GC. Some types have a binary payload at the end (string, word, DLL) which
@ -284,10 +281,7 @@ inline void factor_vm::primitive_data_room()
dpush(a.elements.value());
}
PRIMITIVE(data_room)
{
PRIMITIVE_GETVM()->primitive_data_room();
}
PRIMITIVE_FORWARD(data_room)
/* Disables GC and activates next-object ( -- obj ) primitive */
void factor_vm::begin_scan()
@ -306,10 +300,7 @@ inline void factor_vm::primitive_begin_scan()
begin_scan();
}
PRIMITIVE(begin_scan)
{
PRIMITIVE_GETVM()->primitive_begin_scan();
}
PRIMITIVE_FORWARD(begin_scan)
cell factor_vm::next_object()
{
@ -330,10 +321,7 @@ inline void factor_vm::primitive_next_object()
dpush(next_object());
}
PRIMITIVE(next_object)
{
PRIMITIVE_GETVM()->primitive_next_object();
}
PRIMITIVE_FORWARD(next_object)
/* Re-enables GC */
inline void factor_vm::primitive_end_scan()
@ -341,10 +329,7 @@ inline void factor_vm::primitive_end_scan()
gc_off = false;
}
PRIMITIVE(end_scan)
{
PRIMITIVE_GETVM()->primitive_end_scan();
}
PRIMITIVE_FORWARD(end_scan)
template<typename TYPE> void factor_vm::each_object(TYPE &functor)
{

5
vm/debug.cpp
View File

@ -484,9 +484,6 @@ inline void factor_vm::primitive_die()
factorbug();
}
PRIMITIVE(die)
{
PRIMITIVE_GETVM()->primitive_die();
}
PRIMITIVE_FORWARD(die)
}

20
vm/dispatch.cpp
View File

@ -120,10 +120,7 @@ inline void factor_vm::primitive_lookup_method()
dpush(lookup_method(obj,methods));
}
PRIMITIVE(lookup_method)
{
PRIMITIVE_GETVM()->primitive_lookup_method();
}
PRIMITIVE_FORWARD(lookup_method)
cell factor_vm::object_class(cell obj)
{
@ -169,20 +166,14 @@ inline void factor_vm::primitive_mega_cache_miss()
dpush(method);
}
PRIMITIVE(mega_cache_miss)
{
PRIMITIVE_GETVM()->primitive_mega_cache_miss();
}
PRIMITIVE_FORWARD(mega_cache_miss)
inline void factor_vm::primitive_reset_dispatch_stats()
{
megamorphic_cache_hits = megamorphic_cache_misses = 0;
}
PRIMITIVE(reset_dispatch_stats)
{
PRIMITIVE_GETVM()->primitive_reset_dispatch_stats();
}
PRIMITIVE_FORWARD(reset_dispatch_stats)
inline void factor_vm::primitive_dispatch_stats()
{
@ -193,10 +184,7 @@ inline void factor_vm::primitive_dispatch_stats()
dpush(stats.elements.value());
}
PRIMITIVE(dispatch_stats)
{
PRIMITIVE_GETVM()->primitive_dispatch_stats();
}
PRIMITIVE_FORWARD(dispatch_stats)
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)
{

10
vm/errors.cpp
View File

@ -133,10 +133,7 @@ inline void factor_vm::primitive_call_clear()
throw_impl(dpop(),stack_chain->callstack_bottom,this);
}
PRIMITIVE(call_clear)
{
PRIMITIVE_GETVM()->primitive_call_clear();
}
PRIMITIVE_FORWARD(call_clear)
/* For testing purposes */
inline void factor_vm::primitive_unimplemented()
@ -144,10 +141,7 @@ inline void factor_vm::primitive_unimplemented()
not_implemented_error();
}
PRIMITIVE(unimplemented)
{
PRIMITIVE_GETVM()->primitive_unimplemented();
}
PRIMITIVE_FORWARD(unimplemented)
void factor_vm::memory_signal_handler_impl()
{

10
vm/image.cpp
View File

@ -128,10 +128,7 @@ inline void factor_vm::primitive_save_image()
save_image((vm_char *)(path.untagged() + 1));
}
PRIMITIVE(save_image)
{
PRIMITIVE_GETVM()->primitive_save_image();
}
PRIMITIVE_FORWARD(save_image)
inline void factor_vm::primitive_save_image_and_exit()
{
@ -159,10 +156,7 @@ inline void factor_vm::primitive_save_image_and_exit()
exit(1);
}
PRIMITIVE(save_image_and_exit)
{
PRIMITIVE_GETVM()->primitive_save_image_and_exit();
}
PRIMITIVE_FORWARD(save_image_and_exit)
void factor_vm::data_fixup(cell *cell)
{

10
vm/inline_cache.cpp
View File

@ -257,10 +257,7 @@ inline void factor_vm::primitive_reset_inline_cache_stats()
for(i = 0; i < 4; i++) pic_counts[i] = 0;
}
PRIMITIVE(reset_inline_cache_stats)
{
PRIMITIVE_GETVM()->primitive_reset_inline_cache_stats();
}
PRIMITIVE_FORWARD(reset_inline_cache_stats)
inline void factor_vm::primitive_inline_cache_stats()
{
@ -275,9 +272,6 @@ inline void factor_vm::primitive_inline_cache_stats()
dpush(stats.elements.value());
}
PRIMITIVE(inline_cache_stats)
{
PRIMITIVE_GETVM()->primitive_inline_cache_stats();
}
PRIMITIVE_FORWARD(inline_cache_stats)
}

40
vm/io.cpp
View File

@ -52,10 +52,7 @@ inline void factor_vm::primitive_fopen()
}
}
PRIMITIVE(fopen)
{
PRIMITIVE_GETVM()->primitive_fopen();
}
PRIMITIVE_FORWARD(fopen)
inline void factor_vm::primitive_fgetc()
{
@ -82,10 +79,7 @@ inline void factor_vm::primitive_fgetc()
}
}
PRIMITIVE(fgetc)
{
PRIMITIVE_GETVM()->primitive_fgetc();
}
PRIMITIVE_FORWARD(fgetc)
inline void factor_vm::primitive_fread()
{
@ -127,10 +121,7 @@ inline void factor_vm::primitive_fread()
}
}
PRIMITIVE(fread)
{
PRIMITIVE_GETVM()->primitive_fread();
}
PRIMITIVE_FORWARD(fread)
inline void factor_vm::primitive_fputc()
{
@ -150,10 +141,7 @@ inline void factor_vm::primitive_fputc()
}
}
PRIMITIVE(fputc)
{
PRIMITIVE_GETVM()->primitive_fputc();
}
PRIMITIVE_FORWARD(fputc)
inline void factor_vm::primitive_fwrite()
{
@ -184,10 +172,7 @@ inline void factor_vm::primitive_fwrite()
}
}
PRIMITIVE(fwrite)
{
PRIMITIVE_GETVM()->primitive_fwrite();
}
PRIMITIVE_FORWARD(fwrite)
inline void factor_vm::primitive_fseek()
{
@ -214,10 +199,7 @@ inline void factor_vm::primitive_fseek()
}
}
PRIMITIVE(fseek)
{
PRIMITIVE_GETVM()->primitive_fseek();
}
PRIMITIVE_FORWARD(fseek)
inline void factor_vm::primitive_fflush()
{
@ -231,10 +213,7 @@ inline void factor_vm::primitive_fflush()
}
}
PRIMITIVE(fflush)
{
PRIMITIVE_GETVM()->primitive_fflush();
}
PRIMITIVE_FORWARD(fflush)
inline void factor_vm::primitive_fclose()
{
@ -248,10 +227,7 @@ inline void factor_vm::primitive_fclose()
}
}
PRIMITIVE(fclose)
{
PRIMITIVE_GETVM()->primitive_fclose();
}
PRIMITIVE_FORWARD(fclose)
/* This function is used by FFI I/O. Accessing the errno global directly is
not portable, since on some libc's errno is not a global but a funky macro that

226
vm/math.cpp
View File

@ -8,20 +8,14 @@ inline void factor_vm::primitive_bignum_to_fixnum()
drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
}
PRIMITIVE(bignum_to_fixnum)
{
PRIMITIVE_GETVM()->primitive_bignum_to_fixnum();
}
PRIMITIVE_FORWARD(bignum_to_fixnum)
inline void factor_vm::primitive_float_to_fixnum()
{
drepl(tag_fixnum(float_to_fixnum(dpeek())));
}
PRIMITIVE(float_to_fixnum)
{
PRIMITIVE_GETVM()->primitive_float_to_fixnum();
}
PRIMITIVE_FORWARD(float_to_fixnum)
/* Division can only overflow when we are dividing the most negative fixnum
by -1. */
@ -36,10 +30,7 @@ inline void factor_vm::primitive_fixnum_divint()
drepl(tag_fixnum(result));
}
PRIMITIVE(fixnum_divint)
{
PRIMITIVE_GETVM()->primitive_fixnum_divint();
}
PRIMITIVE_FORWARD(fixnum_divint)
inline void factor_vm::primitive_fixnum_divmod()
{
@ -57,10 +48,7 @@ inline void factor_vm::primitive_fixnum_divmod()
}
}
PRIMITIVE(fixnum_divmod)
{
PRIMITIVE_GETVM()->primitive_fixnum_divmod();
}
PRIMITIVE_FORWARD(fixnum_divmod)
/*
* If we're shifting right by n bits, we won't overflow as long as none of the
@ -108,30 +96,21 @@ inline void factor_vm::primitive_fixnum_shift()
fixnum_to_bignum(x),y)));
}
PRIMITIVE(fixnum_shift)
{
PRIMITIVE_GETVM()->primitive_fixnum_shift();
}
PRIMITIVE_FORWARD(fixnum_shift)
inline void factor_vm::primitive_fixnum_to_bignum()
{
drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
}
PRIMITIVE(fixnum_to_bignum)
{
PRIMITIVE_GETVM()->primitive_fixnum_to_bignum();
}
PRIMITIVE_FORWARD(fixnum_to_bignum)
inline void factor_vm::primitive_float_to_bignum()
{
drepl(tag<bignum>(float_to_bignum(dpeek())));
}
PRIMITIVE(float_to_bignum)
{
PRIMITIVE_GETVM()->primitive_float_to_bignum();
}
PRIMITIVE_FORWARD(float_to_bignum)
#define POP_BIGNUMS(x,y) \
bignum * y = untag<bignum>(dpop()); \
@ -143,10 +122,7 @@ inline void factor_vm::primitive_bignum_eq()
box_boolean(bignum_equal_p(x,y));
}
PRIMITIVE(bignum_eq)
{
PRIMITIVE_GETVM()->primitive_bignum_eq();
}
PRIMITIVE_FORWARD(bignum_eq)
inline void factor_vm::primitive_bignum_add()
{
@ -154,10 +130,7 @@ inline void factor_vm::primitive_bignum_add()
dpush(tag<bignum>(bignum_add(x,y)));
}
PRIMITIVE(bignum_add)
{
PRIMITIVE_GETVM()->primitive_bignum_add();
}
PRIMITIVE_FORWARD(bignum_add)
inline void factor_vm::primitive_bignum_subtract()
{
@ -165,10 +138,7 @@ inline void factor_vm::primitive_bignum_subtract()
dpush(tag<bignum>(bignum_subtract(x,y)));
}
PRIMITIVE(bignum_subtract)
{
PRIMITIVE_GETVM()->primitive_bignum_subtract();
}
PRIMITIVE_FORWARD(bignum_subtract)
inline void factor_vm::primitive_bignum_multiply()
{
@ -176,10 +146,7 @@ inline void factor_vm::primitive_bignum_multiply()
dpush(tag<bignum>(bignum_multiply(x,y)));
}
PRIMITIVE(bignum_multiply)
{
PRIMITIVE_GETVM()->primitive_bignum_multiply();
}
PRIMITIVE_FORWARD(bignum_multiply)
inline void factor_vm::primitive_bignum_divint()
{
@ -187,10 +154,7 @@ inline void factor_vm::primitive_bignum_divint()
dpush(tag<bignum>(bignum_quotient(x,y)));
}
PRIMITIVE(bignum_divint)
{
PRIMITIVE_GETVM()->primitive_bignum_divint();
}
PRIMITIVE_FORWARD(bignum_divint)
inline void factor_vm::primitive_bignum_divmod()
{
@ -201,10 +165,7 @@ inline void factor_vm::primitive_bignum_divmod()
dpush(tag<bignum>(r));
}
PRIMITIVE(bignum_divmod)
{
PRIMITIVE_GETVM()->primitive_bignum_divmod();
}
PRIMITIVE_FORWARD(bignum_divmod)
inline void factor_vm::primitive_bignum_mod()
{
@ -212,10 +173,7 @@ inline void factor_vm::primitive_bignum_mod()
dpush(tag<bignum>(bignum_remainder(x,y)));
}
PRIMITIVE(bignum_mod)
{
PRIMITIVE_GETVM()->primitive_bignum_mod();
}
PRIMITIVE_FORWARD(bignum_mod)
inline void factor_vm::primitive_bignum_and()
{
@ -223,10 +181,7 @@ inline void factor_vm::primitive_bignum_and()
dpush(tag<bignum>(bignum_bitwise_and(x,y)));
}
PRIMITIVE(bignum_and)
{
PRIMITIVE_GETVM()->primitive_bignum_and();
}
PRIMITIVE_FORWARD(bignum_and)
inline void factor_vm::primitive_bignum_or()
{
@ -234,10 +189,7 @@ inline void factor_vm::primitive_bignum_or()
dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
}
PRIMITIVE(bignum_or)
{
PRIMITIVE_GETVM()->primitive_bignum_or();
}
PRIMITIVE_FORWARD(bignum_or)
inline void factor_vm::primitive_bignum_xor()
{
@ -245,10 +197,7 @@ inline void factor_vm::primitive_bignum_xor()
dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
}
PRIMITIVE(bignum_xor)
{
PRIMITIVE_GETVM()->primitive_bignum_xor();
}
PRIMITIVE_FORWARD(bignum_xor)
inline void factor_vm::primitive_bignum_shift()
{
@ -257,10 +206,7 @@ inline void factor_vm::primitive_bignum_shift()
dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
}
PRIMITIVE(bignum_shift)
{
PRIMITIVE_GETVM()->primitive_bignum_shift();
}
PRIMITIVE_FORWARD(bignum_shift)
inline void factor_vm::primitive_bignum_less()
{
@ -268,10 +214,7 @@ inline void factor_vm::primitive_bignum_less()
box_boolean(bignum_compare(x,y) == bignum_comparison_less);
}
PRIMITIVE(bignum_less)
{
PRIMITIVE_GETVM()->primitive_bignum_less();
}
PRIMITIVE_FORWARD(bignum_less)
inline void factor_vm::primitive_bignum_lesseq()
{
@ -279,10 +222,7 @@ inline void factor_vm::primitive_bignum_lesseq()
box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
}
PRIMITIVE(bignum_lesseq)
{
PRIMITIVE_GETVM()->primitive_bignum_lesseq();
}
PRIMITIVE_FORWARD(bignum_lesseq)
inline void factor_vm::primitive_bignum_greater()
{
@ -290,10 +230,7 @@ inline void factor_vm::primitive_bignum_greater()
box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
}
PRIMITIVE(bignum_greater)
{
PRIMITIVE_GETVM()->primitive_bignum_greater();
}
PRIMITIVE_FORWARD(bignum_greater)
inline void factor_vm::primitive_bignum_greatereq()
{
@ -301,20 +238,14 @@ inline void factor_vm::primitive_bignum_greatereq()
box_boolean(bignum_compare(x,y) != bignum_comparison_less);
}
PRIMITIVE(bignum_greatereq)
{
PRIMITIVE_GETVM()->primitive_bignum_greatereq();
}
PRIMITIVE_FORWARD(bignum_greatereq)
inline void factor_vm::primitive_bignum_not()
{
drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
}
PRIMITIVE(bignum_not)
{
PRIMITIVE_GETVM()->primitive_bignum_not();
}
PRIMITIVE_FORWARD(bignum_not)
inline void factor_vm::primitive_bignum_bitp()
{
@ -323,20 +254,14 @@ inline void factor_vm::primitive_bignum_bitp()
box_boolean(bignum_logbitp(bit,x));
}
PRIMITIVE(bignum_bitp)
{
PRIMITIVE_GETVM()->primitive_bignum_bitp();
}
PRIMITIVE_FORWARD(bignum_bitp)
inline void factor_vm::primitive_bignum_log2()
{
drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
}
PRIMITIVE(bignum_log2)
{
PRIMITIVE_GETVM()->primitive_bignum_log2();
}
PRIMITIVE_FORWARD(bignum_log2)
unsigned int factor_vm::bignum_producer(unsigned int digit)
{
@ -356,10 +281,7 @@ inline void factor_vm::primitive_byte_array_to_bignum()
drepl(tag<bignum>(result));
}
PRIMITIVE(byte_array_to_bignum)
{
PRIMITIVE_GETVM()->primitive_byte_array_to_bignum();
}
PRIMITIVE_FORWARD(byte_array_to_bignum)
cell factor_vm::unbox_array_size()
{
@ -399,20 +321,14 @@ inline void factor_vm::primitive_fixnum_to_float()
drepl(allot_float(fixnum_to_float(dpeek())));
}
PRIMITIVE(fixnum_to_float)
{
PRIMITIVE_GETVM()->primitive_fixnum_to_float();
}
PRIMITIVE_FORWARD(fixnum_to_float)
inline void factor_vm::primitive_bignum_to_float()
{
drepl(allot_float(bignum_to_float(dpeek())));
}
PRIMITIVE(bignum_to_float)
{
PRIMITIVE_GETVM()->primitive_bignum_to_float();
}
PRIMITIVE_FORWARD(bignum_to_float)
inline void factor_vm::primitive_str_to_float()
{
@ -428,10 +344,7 @@ inline void factor_vm::primitive_str_to_float()
drepl(F);
}
PRIMITIVE(str_to_float)
{
PRIMITIVE_GETVM()->primitive_str_to_float();
}
PRIMITIVE_FORWARD(str_to_float)
inline void factor_vm::primitive_float_to_str()
{
@ -440,10 +353,7 @@ inline void factor_vm::primitive_float_to_str()
dpush(tag<byte_array>(array));
}
PRIMITIVE(float_to_str)
{
PRIMITIVE_GETVM()->primitive_float_to_str();
}
PRIMITIVE_FORWARD(float_to_str)
#define POP_FLOATS(x,y) \
double y = untag_float(dpop()); \
@ -455,10 +365,7 @@ inline void factor_vm::primitive_float_eq()
box_boolean(x == y);
}
PRIMITIVE(float_eq)
{
PRIMITIVE_GETVM()->primitive_float_eq();
}
PRIMITIVE_FORWARD(float_eq)
inline void factor_vm::primitive_float_add()
{
@ -466,10 +373,7 @@ inline void factor_vm::primitive_float_add()
box_double(x + y);
}
PRIMITIVE(float_add)
{
PRIMITIVE_GETVM()->primitive_float_add();
}
PRIMITIVE_FORWARD(float_add)
inline void factor_vm::primitive_float_subtract()
{
@ -477,10 +381,7 @@ inline void factor_vm::primitive_float_subtract()
box_double(x - y);
}
PRIMITIVE(float_subtract)
{
PRIMITIVE_GETVM()->primitive_float_subtract();
}
PRIMITIVE_FORWARD(float_subtract)
inline void factor_vm::primitive_float_multiply()
{
@ -488,10 +389,7 @@ inline void factor_vm::primitive_float_multiply()
box_double(x * y);
}
PRIMITIVE(float_multiply)
{
PRIMITIVE_GETVM()->primitive_float_multiply();
}
PRIMITIVE_FORWARD(float_multiply)
inline void factor_vm::primitive_float_divfloat()
{
@ -499,10 +397,7 @@ inline void factor_vm::primitive_float_divfloat()
box_double(x / y);
}
PRIMITIVE(float_divfloat)
{
PRIMITIVE_GETVM()->primitive_float_divfloat();
}
PRIMITIVE_FORWARD(float_divfloat)
inline void factor_vm::primitive_float_mod()
{
@ -510,10 +405,7 @@ inline void factor_vm::primitive_float_mod()
box_double(fmod(x,y));
}
PRIMITIVE(float_mod)
{
PRIMITIVE_GETVM()->primitive_float_mod();
}
PRIMITIVE_FORWARD(float_mod)
inline void factor_vm::primitive_float_less()
{
@ -521,10 +413,7 @@ inline void factor_vm::primitive_float_less()
box_boolean(x < y);
}
PRIMITIVE(float_less)
{
PRIMITIVE_GETVM()->primitive_float_less();
}
PRIMITIVE_FORWARD(float_less)
inline void factor_vm::primitive_float_lesseq()
{
@ -532,10 +421,7 @@ inline void factor_vm::primitive_float_lesseq()
box_boolean(x <= y);
}
PRIMITIVE(float_lesseq)
{
PRIMITIVE_GETVM()->primitive_float_lesseq();
}
PRIMITIVE_FORWARD(float_lesseq)
inline void factor_vm::primitive_float_greater()
{
@ -543,10 +429,7 @@ inline void factor_vm::primitive_float_greater()
box_boolean(x > y);
}
PRIMITIVE(float_greater)
{
PRIMITIVE_GETVM()->primitive_float_greater();
}
PRIMITIVE_FORWARD(float_greater)
inline void factor_vm::primitive_float_greatereq()
{
@ -554,50 +437,35 @@ inline void factor_vm::primitive_float_greatereq()
box_boolean(x >= y);
}
PRIMITIVE(float_greatereq)
{
PRIMITIVE_GETVM()->primitive_float_greatereq();
}
PRIMITIVE_FORWARD(float_greatereq)
inline void factor_vm::primitive_float_bits()
{
box_unsigned_4(float_bits(untag_float_check(dpop())));
}
PRIMITIVE(float_bits)
{
PRIMITIVE_GETVM()->primitive_float_bits();
}
PRIMITIVE_FORWARD(float_bits)
inline void factor_vm::primitive_bits_float()
{
box_float(bits_float(to_cell(dpop())));
}
PRIMITIVE(bits_float)
{
PRIMITIVE_GETVM()->primitive_bits_float();
}
PRIMITIVE_FORWARD(bits_float)
inline void factor_vm::primitive_double_bits()
{
box_unsigned_8(double_bits(untag_float_check(dpop())));
}
PRIMITIVE(double_bits)
{
PRIMITIVE_GETVM()->primitive_double_bits();
}
PRIMITIVE_FORWARD(double_bits)
inline void factor_vm::primitive_bits_double()
{
box_double(bits_double(to_unsigned_8(dpop())));
}
PRIMITIVE(bits_double)
{
PRIMITIVE_GETVM()->primitive_bits_double();
}
PRIMITIVE_FORWARD(bits_double)
fixnum factor_vm::to_fixnum(cell tagged)
{
@ -838,7 +706,7 @@ inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y)
untag_fixnum(x) + untag_fixnum(y))));
}
VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *myvm)
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *myvm)
{
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
}
@ -849,7 +717,7 @@ inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y)
untag_fixnum(x) - untag_fixnum(y))));
}
VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *myvm)
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *myvm)
{
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
}
@ -863,7 +731,7 @@ inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y)
drepl(tag<bignum>(bignum_multiply(bx,by)));
}
VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *myvm)
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *myvm)
{
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
}

6
vm/math.hpp
View File

@ -83,8 +83,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 cell to_cell(cell tagged, factor_vm *vm);
VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *vm);
VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *vm);
VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *vm);
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *vm);
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *vm);
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *vm);
}

5
vm/os-unix.cpp
View File

@ -81,10 +81,7 @@ inline void factor_vm::primitive_existsp()
box_boolean(stat(path,&sb) >= 0);
}
PRIMITIVE(existsp)
{
PRIMITIVE_GETVM()->primitive_existsp();
}
PRIMITIVE_FORWARD(existsp)
segment *factor_vm::alloc_segment(cell size)
{

5
vm/os-windows-ce.cpp
View File

@ -30,10 +30,7 @@ char *getenv(char *name)
return 0; /* unreachable */
}
PRIMITIVE(os_envs)
{
vm->not_implemented_error();
}
PRIMITIVE_FORWARD(os_envs)
void c_to_factor_toplevel(cell quot)
{

5
vm/os-windows.cpp
View File

@ -96,10 +96,7 @@ inline void factor_vm::primitive_existsp()
box_boolean(windows_stat(path));
}
PRIMITIVE(existsp)
{
PRIMITIVE_GETVM()->primitive_existsp();
}
PRIMITIVE_FORWARD(existsp)
segment *factor_vm::alloc_segment(cell size)
{

9
vm/primitives.hpp
View File

@ -4,10 +4,17 @@ namespace factor
#if defined(FACTOR_X86)
extern "C" __attribute__ ((regparm (1))) typedef void (*primitive_type)(void *myvm);
#define PRIMITIVE(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm)
#define PRIMITIVE_FORWARD(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm) \
{ \
PRIMITIVE_GETVM()->primitive_##name(); \
}
#else
extern "C" typedef void (*primitive_type)(void *myvm);
#define PRIMITIVE(name) extern "C" void primitive_##name(void *myvm)
#define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(void *myvm) \
{ \
PRIMITIVE_GETVM()->primitive_##name(); \
}
#endif
extern const primitive_type primitives[];
}

5
vm/profiler.cpp
View File

@ -52,9 +52,6 @@ inline void factor_vm::primitive_profiling()
set_profiling(to_boolean(dpop()));
}
PRIMITIVE(profiling)
{
PRIMITIVE_GETVM()->primitive_profiling();
}
PRIMITIVE_FORWARD(profiling)
}

22
vm/quotations.cpp
View File

@ -295,10 +295,7 @@ inline void factor_vm::primitive_jit_compile()
jit_compile(dpop(),true);
}
PRIMITIVE(jit_compile)
{
PRIMITIVE_GETVM()->primitive_jit_compile();
}
PRIMITIVE_FORWARD(jit_compile)
/* push a new quotation on the stack */
inline void factor_vm::primitive_array_to_quotation()
@ -312,10 +309,7 @@ inline void factor_vm::primitive_array_to_quotation()
drepl(tag<quotation>(quot));
}
PRIMITIVE(array_to_quotation)
{
PRIMITIVE_GETVM()->primitive_array_to_quotation();
}
PRIMITIVE_FORWARD(array_to_quotation)
inline void factor_vm::primitive_quotation_xt()
{
@ -323,10 +317,7 @@ inline void factor_vm::primitive_quotation_xt()
drepl(allot_cell((cell)quot->xt));
}
PRIMITIVE(quotation_xt)
{
PRIMITIVE_GETVM()->primitive_quotation_xt();
}
PRIMITIVE_FORWARD(quotation_xt)
void factor_vm::compile_all_words()
{
@ -369,7 +360,7 @@ cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
return quot.value();
}
VM_ASM_API_OVERFLOW cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
{
ASSERTVM();
return VM_PTR->lazy_jit_compile_impl(quot_,stack);
@ -382,9 +373,6 @@ inline void factor_vm::primitive_quot_compiled_p()
dpush(tag_boolean(quot->code != NULL));
}
PRIMITIVE(quot_compiled_p)
{
PRIMITIVE_GETVM()->primitive_quot_compiled_p();
}
PRIMITIVE_FORWARD(quot_compiled_p)
}

2
vm/quotations.hpp
View File

@ -28,7 +28,7 @@ PRIMITIVE(jit_compile);
PRIMITIVE(array_to_quotation);
PRIMITIVE(quotation_xt);
VM_ASM_API_OVERFLOW cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm);
VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm);
PRIMITIVE(quot_compiled_p);

40
vm/run.cpp
View File

@ -9,10 +9,7 @@ inline void factor_vm::primitive_getenv()
drepl(userenv[e]);
}
PRIMITIVE(getenv)
{
PRIMITIVE_GETVM()->primitive_getenv();
}
PRIMITIVE_FORWARD(getenv)
inline void factor_vm::primitive_setenv()
{
@ -21,40 +18,28 @@ inline void factor_vm::primitive_setenv()
userenv[e] = value;
}
PRIMITIVE(setenv)
{
PRIMITIVE_GETVM()->primitive_setenv();
}
PRIMITIVE_FORWARD(setenv)
inline void factor_vm::primitive_exit()
{
exit(to_fixnum(dpop()));
}
PRIMITIVE(exit)
{
PRIMITIVE_GETVM()->primitive_exit();
}
PRIMITIVE_FORWARD(exit)
inline void factor_vm::primitive_micros()
{
box_unsigned_8(current_micros());
}
PRIMITIVE(micros)
{
PRIMITIVE_GETVM()->primitive_micros();
}
PRIMITIVE_FORWARD(micros)
inline void factor_vm::primitive_sleep()
{
sleep_micros(to_cell(dpop()));
}
PRIMITIVE(sleep)
{
PRIMITIVE_GETVM()->primitive_sleep();
}
PRIMITIVE_FORWARD(sleep)
inline void factor_vm::primitive_set_slot()
{
@ -66,10 +51,7 @@ inline void factor_vm::primitive_set_slot()
write_barrier(obj);
}
PRIMITIVE(set_slot)
{
PRIMITIVE_GETVM()->primitive_set_slot();
}
PRIMITIVE_FORWARD(set_slot)
inline void factor_vm::primitive_load_locals()
{
@ -79,10 +61,7 @@ inline void factor_vm::primitive_load_locals()
rs += sizeof(cell) * count;
}
PRIMITIVE(load_locals)
{
PRIMITIVE_GETVM()->primitive_load_locals();
}
PRIMITIVE_FORWARD(load_locals)
cell factor_vm::clone_object(cell obj_)
{
@ -104,9 +83,6 @@ inline void factor_vm::primitive_clone()
drepl(clone_object(dpeek()));
}
PRIMITIVE(clone)
{
PRIMITIVE_GETVM()->primitive_clone();
}
PRIMITIVE_FORWARD(clone)
}

25
vm/strings.cpp
View File

@ -106,10 +106,7 @@ inline void factor_vm::primitive_string()
dpush(tag<string>(allot_string(length,initial)));
}
PRIMITIVE(string)
{
PRIMITIVE_GETVM()->primitive_string();
}
PRIMITIVE_FORWARD(string)
bool factor_vm::reallot_string_in_place_p(string *str, cell capacity)
{
@ -167,10 +164,7 @@ inline void factor_vm::primitive_resize_string()
dpush(tag<string>(reallot_string(str,capacity)));
}
PRIMITIVE(resize_string)
{
PRIMITIVE_GETVM()->primitive_resize_string();
}
PRIMITIVE_FORWARD(resize_string)
inline void factor_vm::primitive_string_nth()
{
@ -179,10 +173,7 @@ inline void factor_vm::primitive_string_nth()
dpush(tag_fixnum(string_nth(str,index)));
}
PRIMITIVE(string_nth)
{
PRIMITIVE_GETVM()->primitive_string_nth();
}
PRIMITIVE_FORWARD(string_nth)
inline void factor_vm::primitive_set_string_nth_fast()
{
@ -192,10 +183,7 @@ inline void factor_vm::primitive_set_string_nth_fast()
set_string_nth_fast(str,index,value);
}
PRIMITIVE(set_string_nth_fast)
{
PRIMITIVE_GETVM()->primitive_set_string_nth_fast();
}
PRIMITIVE_FORWARD(set_string_nth_fast)
inline void factor_vm::primitive_set_string_nth_slow()
{
@ -205,9 +193,6 @@ inline void factor_vm::primitive_set_string_nth_slow()
set_string_nth_slow(str,index,value);
}
PRIMITIVE(set_string_nth_slow)
{
PRIMITIVE_GETVM()->primitive_set_string_nth_slow();
}
PRIMITIVE_FORWARD(set_string_nth_slow)
}

10
vm/tuples.cpp
View File

@ -23,10 +23,7 @@ inline void factor_vm::primitive_tuple()
dpush(tag<tuple>(t));
}
PRIMITIVE(tuple)
{
PRIMITIVE_GETVM()->primitive_tuple();
}
PRIMITIVE_FORWARD(tuple)
/* push a new tuple on the stack, filling its slots from the stack */
inline void factor_vm::primitive_tuple_boa()
@ -39,9 +36,6 @@ inline void factor_vm::primitive_tuple_boa()
dpush(t.value());
}
PRIMITIVE(tuple_boa)
{
PRIMITIVE_GETVM()->primitive_tuple_boa();
}
PRIMITIVE_FORWARD(tuple_boa)
}

20
vm/words.cpp
View File

@ -39,10 +39,7 @@ inline void factor_vm::primitive_word()
dpush(tag<word>(allot_word(vocab,name)));
}
PRIMITIVE(word)
{
PRIMITIVE_GETVM()->primitive_word();
}
PRIMITIVE_FORWARD(word)
/* word-xt ( word -- start end ) */
inline void factor_vm::primitive_word_xt()
@ -53,10 +50,7 @@ inline void factor_vm::primitive_word_xt()
dpush(allot_cell((cell)code + code->size));
}
PRIMITIVE(word_xt)
{
PRIMITIVE_GETVM()->primitive_word_xt();
}
PRIMITIVE_FORWARD(word_xt)
/* Allocates memory */
void factor_vm::update_word_xt(cell w_)
@ -85,10 +79,7 @@ inline void factor_vm::primitive_optimized_p()
drepl(tag_boolean(word_optimized_p(untag_check<word>(dpeek()))));
}
PRIMITIVE(optimized_p)
{
PRIMITIVE_GETVM()->primitive_optimized_p();
}
PRIMITIVE_FORWARD(optimized_p)
inline void factor_vm::primitive_wrapper()
{
@ -97,9 +88,6 @@ inline void factor_vm::primitive_wrapper()
drepl(tag<wrapper>(new_wrapper));
}
PRIMITIVE(wrapper)
{
PRIMITIVE_GETVM()->primitive_wrapper();
}
PRIMITIVE_FORWARD(wrapper)
}