Merge Phil Dawes' VM work
commit
f8a91438cd
26
Makefile
26
Makefile
|
@ -18,6 +18,10 @@ else
|
|||
CFLAGS += -O3
|
||||
endif
|
||||
|
||||
ifdef REENTRANT
|
||||
CFLAGS += -DFACTOR_REENTRANT
|
||||
endif
|
||||
|
||||
CFLAGS += $(SITE_CFLAGS)
|
||||
|
||||
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
|
||||
|
@ -164,17 +168,17 @@ macosx.app: factor
|
|||
Factor.app/Contents/MacOS/factor
|
||||
|
||||
$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
$(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
|
||||
|
||||
$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
$(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
|
||||
|
||||
$(TEST_LIBRARY): vm/ffi_test.o
|
||||
$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
|
||||
$(TOOLCHAIN_PREFIX)$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
|
||||
|
||||
clean:
|
||||
rm -f vm/*.o
|
||||
|
@ -187,22 +191,22 @@ tags:
|
|||
etags vm/*.{cpp,hpp,mm,S,c}
|
||||
|
||||
vm/resources.o:
|
||||
$(WINDRES) vm/factor.rs vm/resources.o
|
||||
$(TOOLCHAIN_PREFIX)$(WINDRES) vm/factor.rs vm/resources.o
|
||||
|
||||
vm/ffi_test.o: vm/ffi_test.c
|
||||
$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $<
|
||||
$(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $<
|
||||
|
||||
.c.o:
|
||||
$(CC) -c $(CFLAGS) -o $@ $<
|
||||
$(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) -o $@ $<
|
||||
|
||||
.cpp.o:
|
||||
$(CPP) -c $(CFLAGS) -o $@ $<
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
|
||||
|
||||
.S.o:
|
||||
$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
|
||||
$(TOOLCHAIN_PREFIX)$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
|
||||
|
||||
.mm.o:
|
||||
$(CPP) -c $(CFLAGS) -o $@ $<
|
||||
$(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
|
||||
|
||||
.PHONY: factor tags clean
|
||||
|
||||
|
|
|
@ -190,12 +190,14 @@ M: ##slot-imm insn-slot# slot>> ;
|
|||
M: ##set-slot insn-slot# slot>> constant ;
|
||||
M: ##set-slot-imm insn-slot# slot>> ;
|
||||
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
|
||||
M: ##vm-field-ptr insn-slot# fieldname>> 1array ; ! is this right?
|
||||
|
||||
M: ##slot insn-object obj>> resolve ;
|
||||
M: ##slot-imm insn-object obj>> resolve ;
|
||||
M: ##set-slot insn-object obj>> resolve ;
|
||||
M: ##set-slot-imm insn-object obj>> resolve ;
|
||||
M: ##alien-global insn-object drop \ ##alien-global ;
|
||||
M: ##vm-field-ptr insn-object drop \ ##vm-field-ptr ;
|
||||
|
||||
: init-alias-analysis ( insns -- insns' )
|
||||
H{ } clone histories set
|
||||
|
|
|
@ -57,4 +57,4 @@ insn-classes get [
|
|||
: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
|
||||
: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ; inline
|
||||
: ^^tag-fixnum ( src -- dst ) tag-bits get ^^shl-imm ; inline
|
||||
: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
|
||||
: ^^untag-fixnum ( src -- dst ) tag-bits get ^^sar-imm ; inline
|
||||
|
|
|
@ -450,6 +450,10 @@ INSN: ##alien-global
|
|||
def: dst/int-rep
|
||||
literal: symbol library ;
|
||||
|
||||
INSN: ##vm-field-ptr
|
||||
def: dst/int-rep
|
||||
literal: fieldname ;
|
||||
|
||||
! FFI
|
||||
INSN: ##alien-invoke
|
||||
literal: params stack-frame ;
|
||||
|
|
|
@ -10,7 +10,7 @@ IN: compiler.cfg.intrinsics.misc
|
|||
ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
|
||||
|
||||
: emit-getenv ( node -- )
|
||||
"userenv" f ^^alien-global
|
||||
"userenv" ^^vm-field-ptr
|
||||
swap node-input-infos first literal>>
|
||||
[ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot 0 ^^slot ] if*
|
||||
ds-push ;
|
||||
|
|
|
@ -270,6 +270,9 @@ M: ##alien-global generate-insn
|
|||
[ dst>> ] [ symbol>> ] [ library>> ] tri
|
||||
%alien-global ;
|
||||
|
||||
M: ##vm-field-ptr generate-insn
|
||||
[ dst>> ] [ fieldname>> ] bi %vm-field-ptr ;
|
||||
|
||||
! ##alien-invoke
|
||||
GENERIC: next-fastcall-param ( rep -- )
|
||||
|
||||
|
@ -434,7 +437,7 @@ M: ##alien-indirect generate-insn
|
|||
! Generate code for boxing input parameters in a callback.
|
||||
[
|
||||
dup \ %save-param-reg move-parameters
|
||||
"nest_stacks" f %alien-invoke
|
||||
"nest_stacks" %vm-invoke-1st-arg
|
||||
box-parameters
|
||||
] with-param-regs ;
|
||||
|
||||
|
@ -472,7 +475,7 @@ TUPLE: callback-context ;
|
|||
[ callback-context new do-callback ] %
|
||||
] [ ] make ;
|
||||
|
||||
: %unnest-stacks ( -- ) "unnest_stacks" f %alien-invoke ;
|
||||
: %unnest-stacks ( -- ) "unnest_stacks" %vm-invoke-1st-arg ;
|
||||
|
||||
M: ##callback-return generate-insn
|
||||
#! All the extra book-keeping for %unwind is only for x86.
|
||||
|
|
|
@ -50,6 +50,7 @@ CONSTANT: rt-immediate 8
|
|||
CONSTANT: rt-stack-chain 9
|
||||
CONSTANT: rt-untagged 10
|
||||
CONSTANT: rt-megamorphic-cache-hits 11
|
||||
CONSTANT: rt-vm 12
|
||||
|
||||
: rc-absolute? ( n -- ? )
|
||||
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
|
||||
|
|
|
@ -202,6 +202,7 @@ HOOK: %set-alien-double cpu ( ptr value -- )
|
|||
HOOK: %set-alien-vector cpu ( ptr value rep -- )
|
||||
|
||||
HOOK: %alien-global cpu ( dst symbol library -- )
|
||||
HOOK: %vm-field-ptr cpu ( dst fieldname -- )
|
||||
|
||||
HOOK: %allot cpu ( dst size class temp -- )
|
||||
HOOK: %write-barrier cpu ( src card# table -- )
|
||||
|
@ -297,6 +298,9 @@ 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 ;
|
||||
|
|
|
@ -7,7 +7,7 @@ cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
|
|||
compiler.cfg.instructions compiler.cfg.comparisons
|
||||
compiler.codegen.fixup compiler.cfg.intrinsics
|
||||
compiler.cfg.stack-frame compiler.cfg.build-stack-frame
|
||||
compiler.units compiler.constants compiler.codegen ;
|
||||
compiler.units compiler.constants compiler.codegen vm ;
|
||||
FROM: cpu.ppc.assembler => B ;
|
||||
FROM: math => float ;
|
||||
IN: cpu.ppc
|
||||
|
@ -30,6 +30,18 @@ enable-float-intrinsics
|
|||
\ ##float>integer t frame-required? set-word-prop
|
||||
>>
|
||||
|
||||
: %load-vm-addr ( reg -- )
|
||||
0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm rel-fixup ;
|
||||
|
||||
: %load-vm-field-addr ( reg symbol -- )
|
||||
[ drop %load-vm-addr ]
|
||||
[ [ dup ] dip vm-field-offset ADDI ] 2bi ;
|
||||
|
||||
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 ] }
|
||||
|
@ -419,7 +431,7 @@ M: ppc %set-alien-float swap 0 STFS ;
|
|||
M: ppc %set-alien-double swap 0 STFD ;
|
||||
|
||||
: load-zone-ptr ( reg -- )
|
||||
"nursery" f %alien-global ;
|
||||
"nursery" %load-vm-field-addr ;
|
||||
|
||||
: load-allot-ptr ( nursery-ptr allot-ptr -- )
|
||||
[ drop load-zone-ptr ] [ swap 4 LWZ ] 2bi ;
|
||||
|
@ -442,10 +454,10 @@ M:: ppc %allot ( dst size class nursery-ptr -- )
|
|||
dst class store-tagged ;
|
||||
|
||||
: load-cards-offset ( dst -- )
|
||||
[ "cards_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
|
||||
[ "cards_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ;
|
||||
|
||||
: load-decks-offset ( dst -- )
|
||||
[ "decks_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
|
||||
[ "decks_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ;
|
||||
|
||||
M:: ppc %write-barrier ( src card# table -- )
|
||||
card-mark scratch-reg LI
|
||||
|
@ -683,7 +695,7 @@ M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
|
|||
#! Save Factor stack pointers in case the C code calls a
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
temp1 "stack_chain" f %alien-global
|
||||
temp1 "stack_chain" %load-vm-field-addr
|
||||
temp1 temp1 0 LWZ
|
||||
1 temp1 0 STW
|
||||
callback-allowed? [
|
||||
|
|
|
@ -47,6 +47,18 @@ 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
|
||||
|
||||
M: x86.32 return-struct-in-registers? ( c-type -- ? )
|
||||
c-type
|
||||
[ return-in-registers?>> ]
|
||||
|
@ -103,9 +115,12 @@ M: x86.32 %save-param-reg 3drop ;
|
|||
#! parameter being passed to a callback from C.
|
||||
over [ load-return-reg ] [ 2drop ] if ;
|
||||
|
||||
CONSTANT: vm-ptr-size 4
|
||||
|
||||
M:: x86.32 %box ( n rep func -- )
|
||||
n rep (%box)
|
||||
rep rep-size [
|
||||
rep rep-size vm-ptr-size + [
|
||||
push-vm-ptr
|
||||
rep push-return-reg
|
||||
func f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
@ -118,7 +133,8 @@ M:: x86.32 %box ( n rep func -- )
|
|||
|
||||
M: x86.32 %box-long-long ( n func -- )
|
||||
[ (%box-long-long) ] dip
|
||||
8 [
|
||||
8 vm-ptr-size + [
|
||||
push-vm-ptr
|
||||
EDX PUSH
|
||||
EAX PUSH
|
||||
f %alien-invoke
|
||||
|
@ -126,12 +142,13 @@ M: x86.32 %box-long-long ( n func -- )
|
|||
|
||||
M:: x86.32 %box-large-struct ( n c-type -- )
|
||||
! Compute destination address
|
||||
ECX n struct-return@ LEA
|
||||
8 [
|
||||
EDX n struct-return@ LEA
|
||||
8 vm-ptr-size + [
|
||||
push-vm-ptr
|
||||
! Push struct size
|
||||
c-type heap-size PUSH
|
||||
! Push destination address
|
||||
ECX PUSH
|
||||
EDX PUSH
|
||||
! Copy the struct from the C stack
|
||||
"box_value_struct" f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
@ -144,7 +161,8 @@ M: x86.32 %prepare-box-struct ( -- )
|
|||
|
||||
M: x86.32 %box-small-struct ( c-type -- )
|
||||
#! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
|
||||
12 [
|
||||
12 vm-ptr-size + [
|
||||
push-vm-ptr
|
||||
heap-size PUSH
|
||||
EDX PUSH
|
||||
EAX PUSH
|
||||
|
@ -157,7 +175,9 @@ M: x86.32 %prepare-unbox ( -- )
|
|||
ESI 4 SUB ;
|
||||
|
||||
: call-unbox-func ( func -- )
|
||||
4 [
|
||||
8 [
|
||||
! push the vm ptr as an argument
|
||||
push-vm-ptr
|
||||
! Push parameter
|
||||
EAX PUSH
|
||||
! Call the unboxer
|
||||
|
@ -183,7 +203,8 @@ M: x86.32 %unbox-long-long ( n func -- )
|
|||
|
||||
: %unbox-struct-1 ( -- )
|
||||
#! Alien must be in EAX.
|
||||
4 [
|
||||
4 vm-ptr-size + [
|
||||
push-vm-ptr
|
||||
EAX PUSH
|
||||
"alien_offset" f %alien-invoke
|
||||
! Load first cell
|
||||
|
@ -192,7 +213,8 @@ M: x86.32 %unbox-long-long ( n func -- )
|
|||
|
||||
: %unbox-struct-2 ( -- )
|
||||
#! Alien must be in EAX.
|
||||
4 [
|
||||
4 vm-ptr-size + [
|
||||
push-vm-ptr
|
||||
EAX PUSH
|
||||
"alien_offset" f %alien-invoke
|
||||
! Load second cell
|
||||
|
@ -211,12 +233,13 @@ M: x86 %unbox-small-struct ( size -- )
|
|||
M:: x86.32 %unbox-large-struct ( n c-type -- )
|
||||
! Alien must be in EAX.
|
||||
! Compute destination address
|
||||
ECX n stack@ LEA
|
||||
12 [
|
||||
EDX n stack@ LEA
|
||||
12 vm-ptr-size + [
|
||||
push-vm-ptr
|
||||
! Push struct size
|
||||
c-type heap-size PUSH
|
||||
! Push destination address
|
||||
ECX PUSH
|
||||
EDX PUSH
|
||||
! Push source address
|
||||
EAX PUSH
|
||||
! Copy the struct to the stack
|
||||
|
@ -224,7 +247,8 @@ M:: x86.32 %unbox-large-struct ( n c-type -- )
|
|||
] with-aligned-stack ;
|
||||
|
||||
M: x86.32 %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
push-vm-ptr "unbox_alien" f %alien-invoke
|
||||
temp-reg POP
|
||||
EBP EAX MOV ;
|
||||
|
||||
M: x86.32 %alien-indirect ( -- )
|
||||
|
@ -234,6 +258,7 @@ M: x86.32 %alien-callback ( quot -- )
|
|||
4 [
|
||||
EAX swap %load-reference
|
||||
EAX PUSH
|
||||
param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup
|
||||
"c_to_factor" f %alien-invoke
|
||||
] with-aligned-stack ;
|
||||
|
||||
|
@ -243,9 +268,11 @@ M: x86.32 %callback-value ( ctype -- )
|
|||
! Save top of data stack in non-volatile register
|
||||
%prepare-unbox
|
||||
EAX PUSH
|
||||
push-vm-ptr
|
||||
! Restore data/call/retain stacks
|
||||
"unnest_stacks" f %alien-invoke
|
||||
! Place top of data stack in EAX
|
||||
temp-reg POP
|
||||
EAX POP
|
||||
! Restore C stack
|
||||
ESP 12 ADD
|
||||
|
|
|
@ -12,6 +12,7 @@ IN: bootstrap.x86
|
|||
: div-arg ( -- reg ) EAX ;
|
||||
: mod-arg ( -- reg ) EDX ;
|
||||
: arg ( -- reg ) EAX ;
|
||||
: arg2 ( -- reg ) EDX ;
|
||||
: temp0 ( -- reg ) EAX ;
|
||||
: temp1 ( -- reg ) EDX ;
|
||||
: temp2 ( -- reg ) ECX ;
|
||||
|
@ -27,6 +28,8 @@ IN: bootstrap.x86
|
|||
temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel
|
||||
! save stack pointer
|
||||
temp0 [] stack-reg MOV
|
||||
! pass vm ptr to primitive
|
||||
arg 0 MOV rc-absolute-cell rt-vm jit-rel
|
||||
! call the primitive
|
||||
0 JMP rc-relative rt-primitive jit-rel
|
||||
] jit-primitive jit-define
|
||||
|
|
|
@ -74,9 +74,26 @@ 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 ;
|
||||
|
||||
|
||||
M:: x86.64 %unbox ( n rep func -- )
|
||||
! Call the unboxer
|
||||
func f %alien-invoke
|
||||
func %vm-invoke-2nd-arg
|
||||
! 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
|
||||
|
@ -92,9 +109,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" f %alien-invoke
|
||||
"alien_offset" %vm-invoke-2nd-arg
|
||||
! Move alien_offset() return value to R11 so that we don't
|
||||
! clobber it.
|
||||
R11 RAX MOV
|
||||
|
@ -109,7 +127,7 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
|
|||
! Load structure size into param-reg-3
|
||||
param-reg-3 c-type heap-size MOV
|
||||
! Copy the struct to the C stack
|
||||
"to_value_struct" f %alien-invoke ;
|
||||
"to_value_struct" %vm-invoke-4th-arg ;
|
||||
|
||||
: load-return-value ( rep -- )
|
||||
[ [ 0 ] dip reg-class-of param-reg ]
|
||||
|
@ -117,6 +135,8 @@ M:: x86.64 %unbox-large-struct ( n c-type -- )
|
|||
[ ]
|
||||
tri copy-register ;
|
||||
|
||||
|
||||
|
||||
M:: x86.64 %box ( n rep func -- )
|
||||
n [
|
||||
n
|
||||
|
@ -125,7 +145,7 @@ M:: x86.64 %box ( n rep func -- )
|
|||
] [
|
||||
rep load-return-value
|
||||
] if
|
||||
func f %alien-invoke ;
|
||||
rep int-rep? [ func %vm-invoke-2nd-arg ] [ func %vm-invoke-1st-arg ] if ;
|
||||
|
||||
M: x86.64 %box-long-long ( n func -- )
|
||||
[ int-rep ] dip %box ;
|
||||
|
@ -145,7 +165,7 @@ 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" f %alien-invoke
|
||||
"box_small_struct" %vm-invoke-4th-arg
|
||||
] with-return-regs ;
|
||||
|
||||
: struct-return@ ( n -- operand )
|
||||
|
@ -157,7 +177,7 @@ M: x86.64 %box-large-struct ( n c-type -- )
|
|||
! Compute destination address
|
||||
param-reg-1 swap struct-return@ LEA
|
||||
! Copy the struct from the C stack
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
"box_value_struct" %vm-invoke-3rd-arg ;
|
||||
|
||||
M: x86.64 %prepare-box-struct ( -- )
|
||||
! Compute target address for value struct return
|
||||
|
@ -172,8 +192,9 @@ M: x86.64 %alien-invoke
|
|||
rc-absolute-cell rel-dlsym
|
||||
R11 CALL ;
|
||||
|
||||
|
||||
M: x86.64 %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
"unbox_alien" %vm-invoke-1st-arg
|
||||
RBP RAX MOV ;
|
||||
|
||||
M: x86.64 %alien-indirect ( -- )
|
||||
|
@ -181,7 +202,7 @@ M: x86.64 %alien-indirect ( -- )
|
|||
|
||||
M: x86.64 %alien-callback ( quot -- )
|
||||
param-reg-1 swap %load-reference
|
||||
"c_to_factor" f %alien-invoke ;
|
||||
"c_to_factor" %vm-invoke-2nd-arg ;
|
||||
|
||||
M: x86.64 %callback-value ( ctype -- )
|
||||
! Save top of data stack
|
||||
|
@ -190,7 +211,7 @@ M: x86.64 %callback-value ( ctype -- )
|
|||
RSP 8 SUB
|
||||
param-reg-1 PUSH
|
||||
! Restore data/call/retain stacks
|
||||
"unnest_stacks" f %alien-invoke
|
||||
"unnest_stacks" %vm-invoke-1st-arg
|
||||
! Put former top of data stack in param-reg-1
|
||||
param-reg-1 POP
|
||||
RSP 8 ADD
|
||||
|
|
|
@ -21,6 +21,7 @@ IN: bootstrap.x86
|
|||
: rex-length ( -- n ) 1 ;
|
||||
|
||||
[
|
||||
|
||||
! load stack_chain
|
||||
temp0 0 MOV rc-absolute-cell rt-stack-chain jit-rel
|
||||
temp0 temp0 [] MOV
|
||||
|
@ -28,6 +29,8 @@ IN: bootstrap.x86
|
|||
temp0 [] stack-reg MOV
|
||||
! load XT
|
||||
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
|
||||
! load vm ptr
|
||||
arg 0 MOV rc-absolute-cell rt-vm jit-rel
|
||||
! go
|
||||
temp1 JMP
|
||||
] jit-primitive jit-define
|
||||
|
|
|
@ -6,6 +6,7 @@ IN: bootstrap.x86
|
|||
|
||||
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
|
||||
: arg ( -- reg ) RDI ;
|
||||
: arg2 ( -- reg ) RSI ;
|
||||
|
||||
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
@ -7,6 +7,7 @@ IN: bootstrap.x86
|
|||
|
||||
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
|
||||
: arg ( -- reg ) RCX ;
|
||||
: arg2 ( -- reg ) RDX ;
|
||||
|
||||
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
@ -251,6 +251,8 @@ big-endian off
|
|||
arg ds-reg [] MOV
|
||||
! pop stack
|
||||
ds-reg bootstrap-cell SUB
|
||||
! pass vm pointer
|
||||
arg2 0 MOV rc-absolute-cell rt-vm jit-rel
|
||||
! call quotation
|
||||
arg quot-xt-offset [+] JMP
|
||||
] \ (call) define-sub-primitive
|
||||
|
|
|
@ -4,13 +4,12 @@ USING: accessors assocs alien alien.c-types arrays strings
|
|||
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
|
||||
cpu.architecture kernel kernel.private math memory namespaces make
|
||||
sequences words system layouts combinators math.order fry locals
|
||||
compiler.constants byte-arrays
|
||||
compiler.constants vm byte-arrays
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.intrinsics
|
||||
compiler.cfg.comparisons
|
||||
compiler.cfg.stack-frame
|
||||
compiler.codegen
|
||||
compiler.codegen.fixup ;
|
||||
FROM: math => float ;
|
||||
IN: cpu.x86
|
||||
|
@ -556,9 +555,13 @@ M: x86 %shl [ SHL ] emit-shift ;
|
|||
M: x86 %shr [ SHR ] emit-shift ;
|
||||
M: x86 %sar [ SAR ] emit-shift ;
|
||||
|
||||
M: x86 %vm-field-ptr ( dst field -- )
|
||||
[ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
|
||||
[ vm-field-offset ADD ] 2bi ;
|
||||
|
||||
: load-zone-ptr ( reg -- )
|
||||
#! Load pointer to start of zone array
|
||||
0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
|
||||
"nursery" %vm-field-ptr ;
|
||||
|
||||
: load-allot-ptr ( nursery-ptr allot-ptr -- )
|
||||
[ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
|
||||
|
@ -578,18 +581,19 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
|
|||
dst class store-tagged
|
||||
nursery-ptr size inc-allot-ptr ;
|
||||
|
||||
|
||||
M:: x86 %write-barrier ( src card# table -- )
|
||||
#! Mark the card pointed to by vreg.
|
||||
! Mark the card
|
||||
card# src MOV
|
||||
card# card-bits SHR
|
||||
table "cards_offset" f %alien-global
|
||||
table "cards_offset" %vm-field-ptr
|
||||
table table [] MOV
|
||||
table card# [+] card-mark <byte> MOV
|
||||
|
||||
! Mark the card deck
|
||||
card# deck-bits card-bits - SHR
|
||||
table "decks_offset" f %alien-global
|
||||
table "decks_offset" %vm-field-ptr
|
||||
table table [] MOV
|
||||
table card# [+] card-mark <byte> MOV ;
|
||||
|
||||
|
@ -611,10 +615,10 @@ M:: x86 %call-gc ( gc-root-count -- )
|
|||
! Pass number of roots as second parameter
|
||||
param-reg-2 gc-root-count MOV
|
||||
! Call GC
|
||||
"inline_gc" f %alien-invoke ;
|
||||
"inline_gc" %vm-invoke-3rd-arg ;
|
||||
|
||||
M: x86 %alien-global
|
||||
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
|
||||
M: x86 %alien-global ( dst symbol library -- )
|
||||
[ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
|
||||
|
||||
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
|
||||
|
||||
|
@ -743,8 +747,8 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
|
|||
#! Save Factor stack pointers in case the C code calls a
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
temp1 "stack_chain" f %alien-global
|
||||
temp1 temp1 [] MOV
|
||||
temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
|
||||
temp1 temp1 "stack_chain" vm-field-offset [+] MOV
|
||||
temp2 stack-reg cell neg [+] LEA
|
||||
temp1 [] temp2 MOV
|
||||
callback-allowed? [
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Phil Dawes
|
|
@ -0,0 +1 @@
|
|||
Layout of the C vm structure
|
|
@ -0,0 +1,23 @@
|
|||
! Copyright (C) 2009 Phil Dawes.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.structs alien.syntax ;
|
||||
IN: vm
|
||||
|
||||
TYPEDEF: void* cell
|
||||
|
||||
C-STRUCT: zone
|
||||
{ "cell" "start" }
|
||||
{ "cell" "here" }
|
||||
{ "cell" "size" }
|
||||
{ "cell" "end" }
|
||||
;
|
||||
|
||||
C-STRUCT: vm
|
||||
{ "context*" "stack_chain" }
|
||||
{ "zone" "nursery" }
|
||||
{ "cell" "cards_offset" }
|
||||
{ "cell" "decks_offset" }
|
||||
{ "cell[70]" "userenv" }
|
||||
;
|
||||
|
||||
: vm-field-offset ( field -- offset ) "vm" offset-of ;
|
|
@ -103,6 +103,7 @@ bootstrapping? on
|
|||
"words"
|
||||
"vectors"
|
||||
"vectors.private"
|
||||
"vm"
|
||||
} [ create-vocab drop ] each
|
||||
|
||||
! Builtin classes
|
||||
|
@ -518,6 +519,7 @@ tuple
|
|||
{ "inline-cache-stats" "generic.single" (( -- stats )) }
|
||||
{ "optimized?" "words" (( word -- ? )) }
|
||||
{ "quot-compiled?" "quotations" (( quot -- ? )) }
|
||||
{ "vm-ptr" "vm" (( -- ptr )) }
|
||||
} [ [ first3 ] dip swap make-primitive ] each-index
|
||||
|
||||
! Bump build number
|
||||
|
|
|
@ -0,0 +1,25 @@
|
|||
USING: alien.syntax io io.encodings.utf16n io.encodings.utf8 io.files
|
||||
kernel namespaces sequences system threads unix.utilities ;
|
||||
IN: mttest
|
||||
|
||||
FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, char** argv ) ;
|
||||
|
||||
HOOK: native-string-encoding os ( -- encoding )
|
||||
M: windows native-string-encoding utf16n ;
|
||||
M: unix native-string-encoding utf8 ;
|
||||
|
||||
: start-vm-in-os-thread ( args -- threadhandle )
|
||||
\ vm get-global prefix
|
||||
[ length ] [ native-string-encoding strings>alien ] bi
|
||||
start_standalone_factor_in_new_thread ;
|
||||
|
||||
: start-tetris-in-os-thread ( -- )
|
||||
{ "-run=tetris" } start-vm-in-os-thread drop ;
|
||||
|
||||
: start-testthread-in-os-thread ( -- )
|
||||
{ "-run=mttest" } start-vm-in-os-thread drop ;
|
||||
|
||||
: testthread ( -- )
|
||||
"/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
|
||||
|
||||
MAIN: testthread
|
|
@ -5,7 +5,7 @@ namespace factor
|
|||
|
||||
/* gets the address of an object representing a C pointer, with the
|
||||
intention of storing the pointer across code which may potentially GC. */
|
||||
char *pinned_alien_offset(cell obj)
|
||||
char *factorvm::pinned_alien_offset(cell obj)
|
||||
{
|
||||
switch(tagged<object>(obj).type())
|
||||
{
|
||||
|
@ -25,10 +25,10 @@ char *pinned_alien_offset(cell obj)
|
|||
}
|
||||
|
||||
/* make an alien */
|
||||
cell allot_alien(cell delegate_, cell displacement)
|
||||
cell factorvm::allot_alien(cell delegate_, cell displacement)
|
||||
{
|
||||
gc_root<object> delegate(delegate_);
|
||||
gc_root<alien> new_alien(allot<alien>(sizeof(alien)));
|
||||
gc_root<object> delegate(delegate_,this);
|
||||
gc_root<alien> new_alien(allot<alien>(sizeof(alien)),this);
|
||||
|
||||
if(delegate.type_p(ALIEN_TYPE))
|
||||
{
|
||||
|
@ -46,7 +46,7 @@ cell allot_alien(cell delegate_, cell displacement)
|
|||
}
|
||||
|
||||
/* make an alien pointing at an offset of another alien */
|
||||
PRIMITIVE(displaced_alien)
|
||||
inline void factorvm::vmprim_displaced_alien()
|
||||
{
|
||||
cell alien = dpop();
|
||||
cell displacement = to_cell(dpop());
|
||||
|
@ -69,15 +69,25 @@ PRIMITIVE(displaced_alien)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(displaced_alien)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_displaced_alien();
|
||||
}
|
||||
|
||||
/* address of an object representing a C pointer. Explicitly throw an error
|
||||
if the object is a byte array, as a sanity check. */
|
||||
PRIMITIVE(alien_address)
|
||||
inline void factorvm::vmprim_alien_address()
|
||||
{
|
||||
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE(alien_address)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_alien_address();
|
||||
}
|
||||
|
||||
/* pop ( alien n ) from datastack, return alien's address plus n */
|
||||
static void *alien_pointer()
|
||||
void *factorvm::alien_pointer()
|
||||
{
|
||||
fixnum offset = to_fixnum(dpop());
|
||||
return unbox_alien() + offset;
|
||||
|
@ -87,12 +97,12 @@ static void *alien_pointer()
|
|||
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
|
||||
PRIMITIVE(alien_##name) \
|
||||
{ \
|
||||
boxer(*(type*)alien_pointer()); \
|
||||
PRIMITIVE_GETVM()->boxer(*(type*)PRIMITIVE_GETVM()->alien_pointer()); \
|
||||
} \
|
||||
PRIMITIVE(set_alien_##name) \
|
||||
{ \
|
||||
type *ptr = (type *)alien_pointer(); \
|
||||
type value = to(dpop()); \
|
||||
type *ptr = (type *)PRIMITIVE_GETVM()->alien_pointer(); \
|
||||
type value = PRIMITIVE_GETVM()->to(dpop()); \
|
||||
*ptr = value; \
|
||||
}
|
||||
|
||||
|
@ -111,22 +121,27 @@ DEFINE_ALIEN_ACCESSOR(double,double,box_double,to_double)
|
|||
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
|
||||
|
||||
/* open a native library and push a handle */
|
||||
PRIMITIVE(dlopen)
|
||||
inline void factorvm::vmprim_dlopen()
|
||||
{
|
||||
gc_root<byte_array> path(dpop());
|
||||
path.untag_check();
|
||||
gc_root<dll> library(allot<dll>(sizeof(dll)));
|
||||
gc_root<byte_array> path(dpop(),this);
|
||||
path.untag_check(this);
|
||||
gc_root<dll> library(allot<dll>(sizeof(dll)),this);
|
||||
library->path = path.value();
|
||||
ffi_dlopen(library.untagged());
|
||||
dpush(library.value());
|
||||
}
|
||||
|
||||
/* look up a symbol in a native library */
|
||||
PRIMITIVE(dlsym)
|
||||
PRIMITIVE(dlopen)
|
||||
{
|
||||
gc_root<object> library(dpop());
|
||||
gc_root<byte_array> name(dpop());
|
||||
name.untag_check();
|
||||
PRIMITIVE_GETVM()->vmprim_dlopen();
|
||||
}
|
||||
|
||||
/* look up a symbol in a native library */
|
||||
inline void factorvm::vmprim_dlsym()
|
||||
{
|
||||
gc_root<object> library(dpop(),this);
|
||||
gc_root<byte_array> name(dpop(),this);
|
||||
name.untag_check(this);
|
||||
|
||||
symbol_char *sym = name->data<symbol_char>();
|
||||
|
||||
|
@ -143,15 +158,25 @@ PRIMITIVE(dlsym)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(dlsym)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_dlsym();
|
||||
}
|
||||
|
||||
/* close a native library handle */
|
||||
PRIMITIVE(dlclose)
|
||||
inline void factorvm::vmprim_dlclose()
|
||||
{
|
||||
dll *d = untag_check<dll>(dpop());
|
||||
if(d->dll != NULL)
|
||||
ffi_dlclose(d);
|
||||
}
|
||||
|
||||
PRIMITIVE(dll_validp)
|
||||
PRIMITIVE(dlclose)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_dlclose();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_dll_validp()
|
||||
{
|
||||
cell library = dpop();
|
||||
if(library == F)
|
||||
|
@ -160,8 +185,13 @@ PRIMITIVE(dll_validp)
|
|||
dpush(untag_check<dll>(library)->dll == NULL ? F : T);
|
||||
}
|
||||
|
||||
PRIMITIVE(dll_validp)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_dll_validp();
|
||||
}
|
||||
|
||||
/* gets the address of an object representing a C pointer */
|
||||
VM_C_API char *alien_offset(cell obj)
|
||||
char *factorvm::alien_offset(cell obj)
|
||||
{
|
||||
switch(tagged<object>(obj).type())
|
||||
{
|
||||
|
@ -182,14 +212,26 @@ VM_C_API char *alien_offset(cell obj)
|
|||
}
|
||||
}
|
||||
|
||||
VM_C_API char *alien_offset(cell obj, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->alien_offset(obj);
|
||||
}
|
||||
|
||||
/* pop an object representing a C pointer */
|
||||
VM_C_API char *unbox_alien()
|
||||
char *factorvm::unbox_alien()
|
||||
{
|
||||
return alien_offset(dpop());
|
||||
}
|
||||
|
||||
VM_C_API char *unbox_alien(factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->unbox_alien();
|
||||
}
|
||||
|
||||
/* make an alien and push */
|
||||
VM_C_API void box_alien(void *ptr)
|
||||
void factorvm::box_alien(void *ptr)
|
||||
{
|
||||
if(ptr == NULL)
|
||||
dpush(F);
|
||||
|
@ -197,22 +239,40 @@ VM_C_API void box_alien(void *ptr)
|
|||
dpush(allot_alien(F,(cell)ptr));
|
||||
}
|
||||
|
||||
VM_C_API void box_alien(void *ptr, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_alien(ptr);
|
||||
}
|
||||
|
||||
/* for FFI calls passing structs by value */
|
||||
VM_C_API void to_value_struct(cell src, void *dest, cell size)
|
||||
void factorvm::to_value_struct(cell src, void *dest, cell size)
|
||||
{
|
||||
memcpy(dest,alien_offset(src),size);
|
||||
}
|
||||
|
||||
VM_C_API void to_value_struct(cell src, void *dest, cell size, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_value_struct(src,dest,size);
|
||||
}
|
||||
|
||||
/* for FFI callbacks receiving structs by value */
|
||||
VM_C_API void box_value_struct(void *src, cell size)
|
||||
void factorvm::box_value_struct(void *src, cell size)
|
||||
{
|
||||
byte_array *bytes = allot_byte_array(size);
|
||||
memcpy(bytes->data<void>(),src,size);
|
||||
dpush(tag<byte_array>(bytes));
|
||||
}
|
||||
|
||||
VM_C_API void box_value_struct(void *src, cell size,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_value_struct(src,size);
|
||||
}
|
||||
|
||||
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
|
||||
VM_C_API void box_small_struct(cell x, cell y, cell size)
|
||||
void factorvm::box_small_struct(cell x, cell y, cell size)
|
||||
{
|
||||
cell data[2];
|
||||
data[0] = x;
|
||||
|
@ -220,8 +280,14 @@ VM_C_API void box_small_struct(cell x, cell y, cell size)
|
|||
box_value_struct(data,size);
|
||||
}
|
||||
|
||||
VM_C_API void box_small_struct(cell x, cell y, cell size, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_small_struct(x,y,size);
|
||||
}
|
||||
|
||||
/* On OS X/PPC, complex numbers are returned in registers. */
|
||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
||||
void factorvm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
||||
{
|
||||
cell data[4];
|
||||
data[0] = x1;
|
||||
|
@ -231,4 +297,20 @@ VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
|
|||
box_value_struct(data,size);
|
||||
}
|
||||
|
||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_vm_ptr()
|
||||
{
|
||||
box_alien(this);
|
||||
}
|
||||
|
||||
PRIMITIVE(vm_ptr)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_vm_ptr();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,8 +1,6 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
cell allot_alien(cell delegate, cell displacement);
|
||||
|
||||
PRIMITIVE(displaced_alien);
|
||||
PRIMITIVE(alien_address);
|
||||
|
||||
|
@ -38,12 +36,14 @@ PRIMITIVE(dlsym);
|
|||
PRIMITIVE(dlclose);
|
||||
PRIMITIVE(dll_validp);
|
||||
|
||||
VM_C_API char *alien_offset(cell object);
|
||||
VM_C_API char *unbox_alien();
|
||||
VM_C_API void box_alien(void *ptr);
|
||||
VM_C_API void to_value_struct(cell src, void *dest, cell size);
|
||||
VM_C_API void box_value_struct(void *src, cell size);
|
||||
VM_C_API void box_small_struct(cell x, cell y, cell size);
|
||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
|
||||
PRIMITIVE(vm_ptr);
|
||||
|
||||
VM_C_API char *alien_offset(cell object, factorvm *vm);
|
||||
VM_C_API char *unbox_alien(factorvm *vm);
|
||||
VM_C_API void box_alien(void *ptr, factorvm *vm);
|
||||
VM_C_API void to_value_struct(cell src, void *dest, cell size, factorvm *vm);
|
||||
VM_C_API void box_value_struct(void *src, cell size,factorvm *vm);
|
||||
VM_C_API void box_small_struct(cell x, cell y, cell size,factorvm *vm);
|
||||
VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size,factorvm *vm);
|
||||
|
||||
}
|
||||
|
|
|
@ -4,10 +4,10 @@ namespace factor
|
|||
{
|
||||
|
||||
/* make a new array with an initial element */
|
||||
array *allot_array(cell capacity, cell fill_)
|
||||
array *factorvm::allot_array(cell capacity, cell fill_)
|
||||
{
|
||||
gc_root<object> fill(fill_);
|
||||
gc_root<array> new_array(allot_array_internal<array>(capacity));
|
||||
gc_root<object> fill(fill_,this);
|
||||
gc_root<array> new_array(allot_array_internal<array>(capacity),this);
|
||||
|
||||
if(fill.value() == tag_fixnum(0))
|
||||
memset(new_array->data(),'\0',capacity * sizeof(cell));
|
||||
|
@ -23,39 +23,47 @@ array *allot_array(cell capacity, cell fill_)
|
|||
return new_array.untagged();
|
||||
}
|
||||
|
||||
|
||||
/* push a new array on the stack */
|
||||
PRIMITIVE(array)
|
||||
inline void factorvm::vmprim_array()
|
||||
{
|
||||
cell initial = dpop();
|
||||
cell size = unbox_array_size();
|
||||
dpush(tag<array>(allot_array(size,initial)));
|
||||
}
|
||||
|
||||
cell allot_array_1(cell obj_)
|
||||
PRIMITIVE(array)
|
||||
{
|
||||
gc_root<object> obj(obj_);
|
||||
gc_root<array> a(allot_array_internal<array>(1));
|
||||
PRIMITIVE_GETVM()->vmprim_array();
|
||||
}
|
||||
|
||||
cell factorvm::allot_array_1(cell obj_)
|
||||
{
|
||||
gc_root<object> obj(obj_,this);
|
||||
gc_root<array> a(allot_array_internal<array>(1),this);
|
||||
set_array_nth(a.untagged(),0,obj.value());
|
||||
return a.value();
|
||||
}
|
||||
|
||||
cell allot_array_2(cell v1_, cell v2_)
|
||||
|
||||
cell factorvm::allot_array_2(cell v1_, cell v2_)
|
||||
{
|
||||
gc_root<object> v1(v1_);
|
||||
gc_root<object> v2(v2_);
|
||||
gc_root<array> a(allot_array_internal<array>(2));
|
||||
gc_root<object> v1(v1_,this);
|
||||
gc_root<object> v2(v2_,this);
|
||||
gc_root<array> a(allot_array_internal<array>(2),this);
|
||||
set_array_nth(a.untagged(),0,v1.value());
|
||||
set_array_nth(a.untagged(),1,v2.value());
|
||||
return a.value();
|
||||
}
|
||||
|
||||
cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
||||
|
||||
cell factorvm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
||||
{
|
||||
gc_root<object> v1(v1_);
|
||||
gc_root<object> v2(v2_);
|
||||
gc_root<object> v3(v3_);
|
||||
gc_root<object> v4(v4_);
|
||||
gc_root<array> a(allot_array_internal<array>(4));
|
||||
gc_root<object> v1(v1_,this);
|
||||
gc_root<object> v2(v2_,this);
|
||||
gc_root<object> v3(v3_,this);
|
||||
gc_root<object> v4(v4_,this);
|
||||
gc_root<array> a(allot_array_internal<array>(4),this);
|
||||
set_array_nth(a.untagged(),0,v1.value());
|
||||
set_array_nth(a.untagged(),1,v2.value());
|
||||
set_array_nth(a.untagged(),2,v3.value());
|
||||
|
@ -63,25 +71,33 @@ cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
|||
return a.value();
|
||||
}
|
||||
|
||||
PRIMITIVE(resize_array)
|
||||
|
||||
inline void factorvm::vmprim_resize_array()
|
||||
{
|
||||
array* a = untag_check<array>(dpop());
|
||||
cell capacity = unbox_array_size();
|
||||
dpush(tag<array>(reallot_array(a,capacity)));
|
||||
}
|
||||
|
||||
PRIMITIVE(resize_array)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_resize_array();
|
||||
}
|
||||
|
||||
void growable_array::add(cell elt_)
|
||||
{
|
||||
gc_root<object> elt(elt_);
|
||||
factorvm* myvm = elements.myvm;
|
||||
gc_root<object> elt(elt_,myvm);
|
||||
if(count == array_capacity(elements.untagged()))
|
||||
elements = reallot_array(elements.untagged(),count * 2);
|
||||
elements = myvm->reallot_array(elements.untagged(),count * 2);
|
||||
|
||||
set_array_nth(elements.untagged(),count++,elt.value());
|
||||
myvm->set_array_nth(elements.untagged(),count++,elt.value());
|
||||
}
|
||||
|
||||
void growable_array::trim()
|
||||
{
|
||||
elements = reallot_array(elements.untagged(),count);
|
||||
factorvm *myvm = elements.myvm;
|
||||
elements = myvm->reallot_array(elements.untagged(),count);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
inline static cell array_nth(array *array, cell slot)
|
||||
inline cell array_nth(array *array, cell slot)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(slot < array_capacity(array));
|
||||
|
@ -10,34 +10,8 @@ inline static cell array_nth(array *array, cell slot)
|
|||
return array->data()[slot];
|
||||
}
|
||||
|
||||
inline static void set_array_nth(array *array, cell slot, cell value)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(slot < array_capacity(array));
|
||||
assert(array->h.hi_tag() == ARRAY_TYPE);
|
||||
check_tagged_pointer(value);
|
||||
#endif
|
||||
array->data()[slot] = value;
|
||||
write_barrier(array);
|
||||
}
|
||||
|
||||
array *allot_array(cell capacity, cell fill);
|
||||
|
||||
cell allot_array_1(cell obj);
|
||||
cell allot_array_2(cell v1, cell v2);
|
||||
cell allot_array_4(cell v1, cell v2, cell v3, cell v4);
|
||||
|
||||
PRIMITIVE(array);
|
||||
PRIMITIVE(resize_array);
|
||||
|
||||
struct growable_array {
|
||||
cell count;
|
||||
gc_root<array> elements;
|
||||
|
||||
growable_array(cell capacity = 10) : count(0), elements(allot_array(capacity,F)) {}
|
||||
|
||||
void add(cell elt);
|
||||
void trim();
|
||||
};
|
||||
|
||||
}
|
||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -44,87 +44,9 @@ enum bignum_comparison
|
|||
bignum_comparison_greater = 1
|
||||
};
|
||||
|
||||
int bignum_equal_p(bignum *, bignum *);
|
||||
enum bignum_comparison bignum_compare(bignum *, bignum *);
|
||||
bignum * bignum_add(bignum *, bignum *);
|
||||
bignum * bignum_subtract(bignum *, bignum *);
|
||||
bignum * bignum_negate(bignum *);
|
||||
bignum * bignum_multiply(bignum *, bignum *);
|
||||
void
|
||||
bignum_divide(bignum * numerator, bignum * denominator,
|
||||
bignum * * quotient, bignum * * remainder);
|
||||
bignum * bignum_quotient(bignum *, bignum *);
|
||||
bignum * bignum_remainder(bignum *, bignum *);
|
||||
bignum * fixnum_to_bignum(fixnum);
|
||||
bignum * cell_to_bignum(cell);
|
||||
bignum * long_long_to_bignum(s64 n);
|
||||
bignum * ulong_long_to_bignum(u64 n);
|
||||
fixnum bignum_to_fixnum(bignum *);
|
||||
cell bignum_to_cell(bignum *);
|
||||
s64 bignum_to_long_long(bignum *);
|
||||
u64 bignum_to_ulong_long(bignum *);
|
||||
bignum * double_to_bignum(double);
|
||||
double bignum_to_double(bignum *);
|
||||
|
||||
/* Added bitwise operators. */
|
||||
|
||||
bignum * bignum_bitwise_not(bignum *);
|
||||
bignum * bignum_arithmetic_shift(bignum *, fixnum);
|
||||
bignum * bignum_bitwise_and(bignum *, bignum *);
|
||||
bignum * bignum_bitwise_ior(bignum *, bignum *);
|
||||
bignum * bignum_bitwise_xor(bignum *, bignum *);
|
||||
|
||||
/* Forward references */
|
||||
int bignum_equal_p_unsigned(bignum *, bignum *);
|
||||
enum bignum_comparison bignum_compare_unsigned(bignum *, bignum *);
|
||||
bignum * bignum_add_unsigned(bignum *, bignum *, int);
|
||||
bignum * bignum_subtract_unsigned(bignum *, bignum *);
|
||||
bignum * bignum_multiply_unsigned(bignum *, bignum *, int);
|
||||
bignum * bignum_multiply_unsigned_small_factor
|
||||
(bignum *, bignum_digit_type, int);
|
||||
void bignum_destructive_scale_up(bignum *, bignum_digit_type);
|
||||
void bignum_destructive_add(bignum *, bignum_digit_type);
|
||||
void bignum_divide_unsigned_large_denominator
|
||||
(bignum *, bignum *, bignum * *, bignum * *, int, int);
|
||||
void bignum_destructive_normalization(bignum *, bignum *, int);
|
||||
void bignum_destructive_unnormalization(bignum *, int);
|
||||
void bignum_divide_unsigned_normalized(bignum *, bignum *, bignum *);
|
||||
bignum_digit_type bignum_divide_subtract
|
||||
(bignum_digit_type *, bignum_digit_type *, bignum_digit_type,
|
||||
bignum_digit_type *);
|
||||
void bignum_divide_unsigned_medium_denominator
|
||||
(bignum *, bignum_digit_type, bignum * *, bignum * *, int, int);
|
||||
bignum_digit_type bignum_digit_divide
|
||||
(bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
|
||||
bignum_digit_type bignum_digit_divide_subtract
|
||||
(bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
|
||||
void bignum_divide_unsigned_small_denominator
|
||||
(bignum *, bignum_digit_type, bignum * *, bignum * *, int, int);
|
||||
bignum_digit_type bignum_destructive_scale_down
|
||||
(bignum *, bignum_digit_type);
|
||||
bignum * bignum_remainder_unsigned_small_denominator
|
||||
(bignum *, bignum_digit_type, int);
|
||||
bignum * bignum_digit_to_bignum(bignum_digit_type, int);
|
||||
bignum * allot_bignum(bignum_length_type, int);
|
||||
bignum * allot_bignum_zeroed(bignum_length_type, int);
|
||||
bignum * bignum_shorten_length(bignum *, bignum_length_type);
|
||||
bignum * bignum_trim(bignum *);
|
||||
bignum * bignum_new_sign(bignum *, int);
|
||||
bignum * bignum_maybe_new_sign(bignum *, int);
|
||||
void bignum_destructive_copy(bignum *, bignum *);
|
||||
|
||||
/* Added for bitwise operations. */
|
||||
bignum * bignum_magnitude_ash(bignum * arg1, fixnum n);
|
||||
bignum * bignum_pospos_bitwise_op(int op, bignum *, bignum *);
|
||||
bignum * bignum_posneg_bitwise_op(int op, bignum *, bignum *);
|
||||
bignum * bignum_negneg_bitwise_op(int op, bignum *, bignum *);
|
||||
void bignum_negate_magnitude(bignum *);
|
||||
|
||||
bignum * bignum_integer_length(bignum * arg1);
|
||||
int bignum_unsigned_logbitp(int shift, bignum * bignum);
|
||||
int bignum_logbitp(int shift, bignum * arg);
|
||||
struct factorvm;
|
||||
bignum * digit_stream_to_bignum(unsigned int n_digits,
|
||||
unsigned int (*producer)(unsigned int),
|
||||
unsigned int (*producer)(unsigned int,factorvm*),
|
||||
unsigned int radix,
|
||||
int negative_p);
|
||||
|
||||
|
|
|
@ -3,14 +3,26 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
VM_C_API void box_boolean(bool value)
|
||||
void factorvm::box_boolean(bool value)
|
||||
{
|
||||
dpush(value ? T : F);
|
||||
}
|
||||
|
||||
VM_C_API bool to_boolean(cell value)
|
||||
VM_C_API void box_boolean(bool value, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_boolean(value);
|
||||
}
|
||||
|
||||
bool factorvm::to_boolean(cell value)
|
||||
{
|
||||
return value != F;
|
||||
}
|
||||
|
||||
VM_C_API bool to_boolean(cell value, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_boolean(value);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,12 +1,8 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
inline static cell tag_boolean(cell untagged)
|
||||
{
|
||||
return (untagged ? T : F);
|
||||
}
|
||||
|
||||
VM_C_API void box_boolean(bool value);
|
||||
VM_C_API bool to_boolean(cell value);
|
||||
VM_C_API void box_boolean(bool value, factorvm *vm);
|
||||
VM_C_API bool to_boolean(cell value, factorvm *vm);
|
||||
|
||||
}
|
||||
|
|
|
@ -3,38 +3,54 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
byte_array *allot_byte_array(cell size)
|
||||
byte_array *factorvm::allot_byte_array(cell size)
|
||||
{
|
||||
byte_array *array = allot_array_internal<byte_array>(size);
|
||||
memset(array + 1,0,size);
|
||||
return array;
|
||||
}
|
||||
|
||||
PRIMITIVE(byte_array)
|
||||
|
||||
inline void factorvm::vmprim_byte_array()
|
||||
{
|
||||
cell size = unbox_array_size();
|
||||
dpush(tag<byte_array>(allot_byte_array(size)));
|
||||
}
|
||||
|
||||
PRIMITIVE(uninitialized_byte_array)
|
||||
PRIMITIVE(byte_array)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_byte_array();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_uninitialized_byte_array()
|
||||
{
|
||||
cell size = unbox_array_size();
|
||||
dpush(tag<byte_array>(allot_array_internal<byte_array>(size)));
|
||||
}
|
||||
|
||||
PRIMITIVE(resize_byte_array)
|
||||
PRIMITIVE(uninitialized_byte_array)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_uninitialized_byte_array();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_resize_byte_array()
|
||||
{
|
||||
byte_array *array = untag_check<byte_array>(dpop());
|
||||
cell capacity = unbox_array_size();
|
||||
dpush(tag<byte_array>(reallot_array(array,capacity)));
|
||||
}
|
||||
|
||||
PRIMITIVE(resize_byte_array)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_resize_byte_array();
|
||||
}
|
||||
|
||||
void growable_byte_array::append_bytes(void *elts, cell len)
|
||||
{
|
||||
cell new_size = count + len;
|
||||
|
||||
factorvm *myvm = elements.myvm;
|
||||
if(new_size >= array_capacity(elements.untagged()))
|
||||
elements = reallot_array(elements.untagged(),new_size * 2);
|
||||
elements = myvm->reallot_array(elements.untagged(),new_size * 2);
|
||||
|
||||
memcpy(&elements->data<u8>()[count],elts,len);
|
||||
|
||||
|
@ -43,13 +59,13 @@ void growable_byte_array::append_bytes(void *elts, cell len)
|
|||
|
||||
void growable_byte_array::append_byte_array(cell byte_array_)
|
||||
{
|
||||
gc_root<byte_array> byte_array(byte_array_);
|
||||
gc_root<byte_array> byte_array(byte_array_,elements.myvm);
|
||||
|
||||
cell len = array_capacity(byte_array.untagged());
|
||||
cell new_size = count + len;
|
||||
|
||||
factorvm *myvm = elements.myvm;
|
||||
if(new_size >= array_capacity(elements.untagged()))
|
||||
elements = reallot_array(elements.untagged(),new_size * 2);
|
||||
elements = myvm->reallot_array(elements.untagged(),new_size * 2);
|
||||
|
||||
memcpy(&elements->data<u8>()[count],byte_array->data<u8>(),len);
|
||||
|
||||
|
@ -58,7 +74,8 @@ void growable_byte_array::append_byte_array(cell byte_array_)
|
|||
|
||||
void growable_byte_array::trim()
|
||||
{
|
||||
elements = reallot_array(elements.untagged(),count);
|
||||
factorvm *myvm = elements.myvm;
|
||||
elements = myvm->reallot_array(elements.untagged(),count);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,22 +1,9 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
byte_array *allot_byte_array(cell size);
|
||||
|
||||
PRIMITIVE(byte_array);
|
||||
PRIMITIVE(uninitialized_byte_array);
|
||||
PRIMITIVE(resize_byte_array);
|
||||
|
||||
struct growable_byte_array {
|
||||
cell count;
|
||||
gc_root<byte_array> elements;
|
||||
|
||||
growable_byte_array(cell capacity = 40) : count(0), elements(allot_byte_array(capacity)) { }
|
||||
|
||||
void append_bytes(void *elts, cell len);
|
||||
void append_byte_array(cell elts);
|
||||
|
||||
void trim();
|
||||
};
|
||||
|
||||
}
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
static void check_frame(stack_frame *frame)
|
||||
void factorvm::check_frame(stack_frame *frame)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
check_code_pointer((cell)frame->xt);
|
||||
|
@ -11,14 +11,14 @@ static void check_frame(stack_frame *frame)
|
|||
#endif
|
||||
}
|
||||
|
||||
callstack *allot_callstack(cell size)
|
||||
callstack *factorvm::allot_callstack(cell size)
|
||||
{
|
||||
callstack *stack = allot<callstack>(callstack_size(size));
|
||||
stack->length = tag_fixnum(size);
|
||||
return stack;
|
||||
}
|
||||
|
||||
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
|
||||
stack_frame *factorvm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
|
||||
{
|
||||
stack_frame *frame = bottom - 1;
|
||||
|
||||
|
@ -35,7 +35,7 @@ This means that if 'callstack' is called in tail position, we
|
|||
will have popped a necessary frame... however this word is only
|
||||
called by continuation implementation, and user code shouldn't
|
||||
be calling it at all, so we leave it as it is for now. */
|
||||
stack_frame *capture_start()
|
||||
stack_frame *factorvm::capture_start()
|
||||
{
|
||||
stack_frame *frame = stack_chain->callstack_bottom - 1;
|
||||
while(frame >= stack_chain->callstack_top
|
||||
|
@ -46,7 +46,7 @@ stack_frame *capture_start()
|
|||
return frame + 1;
|
||||
}
|
||||
|
||||
PRIMITIVE(callstack)
|
||||
inline void factorvm::vmprim_callstack()
|
||||
{
|
||||
stack_frame *top = capture_start();
|
||||
stack_frame *bottom = stack_chain->callstack_bottom;
|
||||
|
@ -60,7 +60,12 @@ PRIMITIVE(callstack)
|
|||
dpush(tag<callstack>(stack));
|
||||
}
|
||||
|
||||
PRIMITIVE(set_callstack)
|
||||
PRIMITIVE(callstack)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_callstack();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_set_callstack()
|
||||
{
|
||||
callstack *stack = untag_check<callstack>(dpop());
|
||||
|
||||
|
@ -73,18 +78,24 @@ PRIMITIVE(set_callstack)
|
|||
critical_error("Bug in set_callstack()",0);
|
||||
}
|
||||
|
||||
code_block *frame_code(stack_frame *frame)
|
||||
PRIMITIVE(set_callstack)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_set_callstack();
|
||||
}
|
||||
|
||||
code_block *factorvm::frame_code(stack_frame *frame)
|
||||
{
|
||||
check_frame(frame);
|
||||
return (code_block *)frame->xt - 1;
|
||||
}
|
||||
|
||||
cell frame_type(stack_frame *frame)
|
||||
|
||||
cell factorvm::frame_type(stack_frame *frame)
|
||||
{
|
||||
return frame_code(frame)->type;
|
||||
}
|
||||
|
||||
cell frame_executing(stack_frame *frame)
|
||||
cell factorvm::frame_executing(stack_frame *frame)
|
||||
{
|
||||
code_block *compiled = frame_code(frame);
|
||||
if(compiled->literals == F || !stack_traces_p())
|
||||
|
@ -98,14 +109,14 @@ cell frame_executing(stack_frame *frame)
|
|||
}
|
||||
}
|
||||
|
||||
stack_frame *frame_successor(stack_frame *frame)
|
||||
stack_frame *factorvm::frame_successor(stack_frame *frame)
|
||||
{
|
||||
check_frame(frame);
|
||||
return (stack_frame *)((cell)frame - frame->size);
|
||||
}
|
||||
|
||||
/* Allocates memory */
|
||||
cell frame_scan(stack_frame *frame)
|
||||
cell factorvm::frame_scan(stack_frame *frame)
|
||||
{
|
||||
switch(frame_type(frame))
|
||||
{
|
||||
|
@ -137,10 +148,12 @@ namespace
|
|||
struct stack_frame_accumulator {
|
||||
growable_array frames;
|
||||
|
||||
void operator()(stack_frame *frame)
|
||||
stack_frame_accumulator(factorvm *vm) : frames(vm) {}
|
||||
|
||||
void operator()(stack_frame *frame, factorvm *myvm)
|
||||
{
|
||||
gc_root<object> executing(frame_executing(frame));
|
||||
gc_root<object> scan(frame_scan(frame));
|
||||
gc_root<object> executing(myvm->frame_executing(frame),myvm);
|
||||
gc_root<object> scan(myvm->frame_scan(frame),myvm);
|
||||
|
||||
frames.add(executing.value());
|
||||
frames.add(scan.value());
|
||||
|
@ -149,18 +162,23 @@ struct stack_frame_accumulator {
|
|||
|
||||
}
|
||||
|
||||
PRIMITIVE(callstack_to_array)
|
||||
inline void factorvm::vmprim_callstack_to_array()
|
||||
{
|
||||
gc_root<callstack> callstack(dpop());
|
||||
gc_root<callstack> callstack(dpop(),this);
|
||||
|
||||
stack_frame_accumulator accum;
|
||||
stack_frame_accumulator accum(this);
|
||||
iterate_callstack_object(callstack.untagged(),accum);
|
||||
accum.frames.trim();
|
||||
|
||||
dpush(accum.frames.elements.value());
|
||||
}
|
||||
|
||||
stack_frame *innermost_stack_frame(callstack *stack)
|
||||
PRIMITIVE(callstack_to_array)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_callstack_to_array();
|
||||
}
|
||||
|
||||
stack_frame *factorvm::innermost_stack_frame(callstack *stack)
|
||||
{
|
||||
stack_frame *top = stack->top();
|
||||
stack_frame *bottom = stack->bottom();
|
||||
|
@ -172,32 +190,42 @@ stack_frame *innermost_stack_frame(callstack *stack)
|
|||
return frame;
|
||||
}
|
||||
|
||||
stack_frame *innermost_stack_frame_quot(callstack *callstack)
|
||||
stack_frame *factorvm::innermost_stack_frame_quot(callstack *callstack)
|
||||
{
|
||||
stack_frame *inner = innermost_stack_frame(callstack);
|
||||
tagged<quotation>(frame_executing(inner)).untag_check();
|
||||
tagged<quotation>(frame_executing(inner)).untag_check(this);
|
||||
return inner;
|
||||
}
|
||||
|
||||
/* Some primitives implementing a limited form of callstack mutation.
|
||||
Used by the single stepper. */
|
||||
PRIMITIVE(innermost_stack_frame_executing)
|
||||
inline void factorvm::vmprim_innermost_stack_frame_executing()
|
||||
{
|
||||
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
|
||||
}
|
||||
|
||||
PRIMITIVE(innermost_stack_frame_scan)
|
||||
PRIMITIVE(innermost_stack_frame_executing)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_executing();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_innermost_stack_frame_scan()
|
||||
{
|
||||
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
|
||||
}
|
||||
|
||||
PRIMITIVE(set_innermost_stack_frame_quot)
|
||||
PRIMITIVE(innermost_stack_frame_scan)
|
||||
{
|
||||
gc_root<callstack> callstack(dpop());
|
||||
gc_root<quotation> quot(dpop());
|
||||
PRIMITIVE_GETVM()->vmprim_innermost_stack_frame_scan();
|
||||
}
|
||||
|
||||
callstack.untag_check();
|
||||
quot.untag_check();
|
||||
inline void factorvm::vmprim_set_innermost_stack_frame_quot()
|
||||
{
|
||||
gc_root<callstack> callstack(dpop(),this);
|
||||
gc_root<quotation> quot(dpop(),this);
|
||||
|
||||
callstack.untag_check(this);
|
||||
quot.untag_check(this);
|
||||
|
||||
jit_compile(quot.value(),true);
|
||||
|
||||
|
@ -207,10 +235,21 @@ PRIMITIVE(set_innermost_stack_frame_quot)
|
|||
FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
|
||||
}
|
||||
|
||||
PRIMITIVE(set_innermost_stack_frame_quot)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_set_innermost_stack_frame_quot();
|
||||
}
|
||||
|
||||
/* called before entry into Factor code. */
|
||||
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
|
||||
void factorvm::save_callstack_bottom(stack_frame *callstack_bottom)
|
||||
{
|
||||
stack_chain->callstack_bottom = callstack_bottom;
|
||||
}
|
||||
|
||||
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->save_callstack_bottom(callstack_bottom);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -6,13 +6,6 @@ inline static cell callstack_size(cell size)
|
|||
return sizeof(callstack) + size;
|
||||
}
|
||||
|
||||
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
|
||||
stack_frame *frame_successor(stack_frame *frame);
|
||||
code_block *frame_code(stack_frame *frame);
|
||||
cell frame_executing(stack_frame *frame);
|
||||
cell frame_scan(stack_frame *frame);
|
||||
cell frame_type(stack_frame *frame);
|
||||
|
||||
PRIMITIVE(callstack);
|
||||
PRIMITIVE(set_callstack);
|
||||
PRIMITIVE(callstack_to_array);
|
||||
|
@ -20,32 +13,8 @@ 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);
|
||||
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom,factorvm *vm);
|
||||
|
||||
template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
|
||||
{
|
||||
stack_frame *frame = (stack_frame *)bottom - 1;
|
||||
|
||||
while((cell)frame >= top)
|
||||
{
|
||||
iterator(frame);
|
||||
frame = frame_successor(frame);
|
||||
}
|
||||
}
|
||||
|
||||
/* This is a little tricky. The iterator may allocate memory, so we
|
||||
keep the callstack in a GC root and use relative offsets */
|
||||
template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
|
||||
{
|
||||
gc_root<callstack> stack(stack_);
|
||||
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
|
||||
|
||||
while(frame_offset >= 0)
|
||||
{
|
||||
stack_frame *frame = stack->frame_at(frame_offset);
|
||||
frame_offset -= frame->size;
|
||||
iterator(frame);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -3,27 +3,31 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
static relocation_type relocation_type_of(relocation_entry r)
|
||||
relocation_type factorvm::relocation_type_of(relocation_entry r)
|
||||
{
|
||||
return (relocation_type)((r & 0xf0000000) >> 28);
|
||||
}
|
||||
|
||||
static relocation_class relocation_class_of(relocation_entry r)
|
||||
|
||||
relocation_class factorvm::relocation_class_of(relocation_entry r)
|
||||
{
|
||||
return (relocation_class)((r & 0x0f000000) >> 24);
|
||||
}
|
||||
|
||||
static cell relocation_offset_of(relocation_entry r)
|
||||
|
||||
cell factorvm::relocation_offset_of(relocation_entry r)
|
||||
{
|
||||
return (r & 0x00ffffff);
|
||||
}
|
||||
|
||||
void flush_icache_for(code_block *block)
|
||||
|
||||
void factorvm::flush_icache_for(code_block *block)
|
||||
{
|
||||
flush_icache((cell)block,block->size);
|
||||
}
|
||||
|
||||
static int number_of_parameters(relocation_type type)
|
||||
|
||||
int factorvm::number_of_parameters(relocation_type type)
|
||||
{
|
||||
switch(type)
|
||||
{
|
||||
|
@ -40,6 +44,7 @@ static int number_of_parameters(relocation_type type)
|
|||
case RT_THIS:
|
||||
case RT_STACK_CHAIN:
|
||||
case RT_MEGAMORPHIC_CACHE_HITS:
|
||||
case RT_VM:
|
||||
return 0;
|
||||
default:
|
||||
critical_error("Bad rel type",type);
|
||||
|
@ -47,7 +52,8 @@ static int number_of_parameters(relocation_type type)
|
|||
}
|
||||
}
|
||||
|
||||
void *object_xt(cell obj)
|
||||
|
||||
void *factorvm::object_xt(cell obj)
|
||||
{
|
||||
switch(tagged<object>(obj).type())
|
||||
{
|
||||
|
@ -61,7 +67,8 @@ void *object_xt(cell obj)
|
|||
}
|
||||
}
|
||||
|
||||
static void *xt_pic(word *w, cell tagged_quot)
|
||||
|
||||
void *factorvm::xt_pic(word *w, cell tagged_quot)
|
||||
{
|
||||
if(tagged_quot == F || max_pic_size == 0)
|
||||
return w->xt;
|
||||
|
@ -75,25 +82,33 @@ static void *xt_pic(word *w, cell tagged_quot)
|
|||
}
|
||||
}
|
||||
|
||||
void *word_xt_pic(word *w)
|
||||
|
||||
void *factorvm::word_xt_pic(word *w)
|
||||
{
|
||||
return xt_pic(w,w->pic_def);
|
||||
}
|
||||
|
||||
void *word_xt_pic_tail(word *w)
|
||||
|
||||
void *factorvm::word_xt_pic_tail(word *w)
|
||||
{
|
||||
return xt_pic(w,w->pic_tail_def);
|
||||
}
|
||||
|
||||
|
||||
/* References to undefined symbols are patched up to call this function on
|
||||
image load */
|
||||
void undefined_symbol()
|
||||
void factorvm::undefined_symbol()
|
||||
{
|
||||
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
|
||||
}
|
||||
|
||||
void undefined_symbol(factorvm *myvm)
|
||||
{
|
||||
return myvm->undefined_symbol();
|
||||
}
|
||||
|
||||
/* Look up an external library symbol referenced by a compiled code block */
|
||||
void *get_rel_symbol(array *literals, cell index)
|
||||
void *factorvm::get_rel_symbol(array *literals, cell index)
|
||||
{
|
||||
cell symbol = array_nth(literals,index);
|
||||
cell library = array_nth(literals,index + 1);
|
||||
|
@ -101,7 +116,7 @@ void *get_rel_symbol(array *literals, cell index)
|
|||
dll *d = (library == F ? NULL : untag<dll>(library));
|
||||
|
||||
if(d != NULL && !d->dll)
|
||||
return (void *)undefined_symbol;
|
||||
return (void *)factor::undefined_symbol;
|
||||
|
||||
switch(tagged<object>(symbol).type())
|
||||
{
|
||||
|
@ -114,7 +129,7 @@ void *get_rel_symbol(array *literals, cell index)
|
|||
return sym;
|
||||
else
|
||||
{
|
||||
return (void *)undefined_symbol;
|
||||
return (void *)factor::undefined_symbol;
|
||||
}
|
||||
}
|
||||
case ARRAY_TYPE:
|
||||
|
@ -129,15 +144,16 @@ void *get_rel_symbol(array *literals, cell index)
|
|||
if(sym)
|
||||
return sym;
|
||||
}
|
||||
return (void *)undefined_symbol;
|
||||
return (void *)factor::undefined_symbol;
|
||||
}
|
||||
default:
|
||||
critical_error("Bad symbol specifier",symbol);
|
||||
return (void *)undefined_symbol;
|
||||
return (void *)factor::undefined_symbol;
|
||||
}
|
||||
}
|
||||
|
||||
cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
|
||||
|
||||
cell factorvm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
array *literals = untag<array>(compiled->literals);
|
||||
cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
|
||||
|
@ -171,6 +187,8 @@ cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
|
|||
return untag_fixnum(ARG);
|
||||
case RT_MEGAMORPHIC_CACHE_HITS:
|
||||
return (cell)&megamorphic_cache_hits;
|
||||
case RT_VM:
|
||||
return (cell)this;
|
||||
default:
|
||||
critical_error("Bad rel type",rel);
|
||||
return 0; /* Can't happen */
|
||||
|
@ -179,7 +197,8 @@ cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
|
|||
#undef ARG
|
||||
}
|
||||
|
||||
void iterate_relocations(code_block *compiled, relocation_iterator iter)
|
||||
|
||||
void factorvm::iterate_relocations(code_block *compiled, relocation_iterator iter)
|
||||
{
|
||||
if(compiled->relocation != F)
|
||||
{
|
||||
|
@ -191,21 +210,23 @@ void iterate_relocations(code_block *compiled, relocation_iterator iter)
|
|||
for(cell i = 0; i < length; i++)
|
||||
{
|
||||
relocation_entry rel = relocation->data<relocation_entry>()[i];
|
||||
iter(rel,index,compiled);
|
||||
iter(rel,index,compiled,this);
|
||||
index += number_of_parameters(relocation_type_of(rel));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
|
||||
static void store_address_2_2(cell *ptr, cell value)
|
||||
void factorvm::store_address_2_2(cell *ptr, cell value)
|
||||
{
|
||||
ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
|
||||
ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
|
||||
}
|
||||
|
||||
|
||||
/* Store a value into a bitfield of a PowerPC instruction */
|
||||
static void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
|
||||
void factorvm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
|
||||
{
|
||||
/* This is unaccurate but good enough */
|
||||
fixnum test = (fixnum)mask >> 1;
|
||||
|
@ -215,8 +236,9 @@ static void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shif
|
|||
*ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
|
||||
}
|
||||
|
||||
|
||||
/* Perform a fixup on a code block */
|
||||
void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
|
||||
void factorvm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
|
||||
{
|
||||
fixnum relative_value = absolute_value - offset;
|
||||
|
||||
|
@ -261,7 +283,8 @@ void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
|
|||
}
|
||||
}
|
||||
|
||||
void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
|
||||
void factorvm::update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
if(relocation_type_of(rel) == RT_IMMEDIATE)
|
||||
{
|
||||
|
@ -272,19 +295,25 @@ void update_literal_references_step(relocation_entry rel, cell index, code_block
|
|||
}
|
||||
}
|
||||
|
||||
void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
|
||||
{
|
||||
return myvm->update_literal_references_step(rel,index,compiled);
|
||||
}
|
||||
|
||||
/* Update pointers to literals from compiled code. */
|
||||
void update_literal_references(code_block *compiled)
|
||||
void factorvm::update_literal_references(code_block *compiled)
|
||||
{
|
||||
if(!compiled->needs_fixup)
|
||||
{
|
||||
iterate_relocations(compiled,update_literal_references_step);
|
||||
iterate_relocations(compiled,factor::update_literal_references_step);
|
||||
flush_icache_for(compiled);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Copy all literals referenced from a code block to newspace. Only for
|
||||
aging and nursery collections */
|
||||
void copy_literal_references(code_block *compiled)
|
||||
void factorvm::copy_literal_references(code_block *compiled)
|
||||
{
|
||||
if(collecting_gen >= compiled->last_scan)
|
||||
{
|
||||
|
@ -307,12 +336,17 @@ void copy_literal_references(code_block *compiled)
|
|||
}
|
||||
}
|
||||
|
||||
void copy_literal_references(code_block *compiled, factorvm *myvm)
|
||||
{
|
||||
return myvm->copy_literal_references(compiled);
|
||||
}
|
||||
|
||||
/* Compute an address to store at a relocation */
|
||||
void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
void factorvm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
tagged<array>(compiled->literals).untag_check();
|
||||
tagged<byte_array>(compiled->relocation).untag_check();
|
||||
tagged<array>(compiled->literals).untag_check(this);
|
||||
tagged<byte_array>(compiled->relocation).untag_check(this);
|
||||
#endif
|
||||
|
||||
store_address_in_code_block(relocation_class_of(rel),
|
||||
|
@ -320,18 +354,28 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp
|
|||
compute_relocation(rel,index,compiled));
|
||||
}
|
||||
|
||||
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
|
||||
{
|
||||
return myvm->relocate_code_block_step(rel,index,compiled);
|
||||
}
|
||||
|
||||
void factorvm::update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
|
||||
{
|
||||
relocation_type type = relocation_type_of(rel);
|
||||
if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
|
||||
relocate_code_block_step(rel,index,compiled);
|
||||
}
|
||||
|
||||
void update_word_references_step(relocation_entry rel, cell index, code_block *compiled, factorvm *myvm)
|
||||
{
|
||||
return myvm->update_word_references_step(rel,index,compiled);
|
||||
}
|
||||
|
||||
/* Relocate new code blocks completely; updating references to literals,
|
||||
dlsyms, and words. For all other words in the code heap, we only need
|
||||
to update references to other words, without worrying about literals
|
||||
or dlsyms. */
|
||||
void update_word_references(code_block *compiled)
|
||||
void factorvm::update_word_references(code_block *compiled)
|
||||
{
|
||||
if(compiled->needs_fixup)
|
||||
relocate_code_block(compiled);
|
||||
|
@ -346,30 +390,41 @@ void update_word_references(code_block *compiled)
|
|||
heap_free(&code,compiled);
|
||||
else
|
||||
{
|
||||
iterate_relocations(compiled,update_word_references_step);
|
||||
iterate_relocations(compiled,factor::update_word_references_step);
|
||||
flush_icache_for(compiled);
|
||||
}
|
||||
}
|
||||
|
||||
void update_literal_and_word_references(code_block *compiled)
|
||||
void update_word_references(code_block *compiled, factorvm *myvm)
|
||||
{
|
||||
return myvm->update_word_references(compiled);
|
||||
}
|
||||
|
||||
void factorvm::update_literal_and_word_references(code_block *compiled)
|
||||
{
|
||||
update_literal_references(compiled);
|
||||
update_word_references(compiled);
|
||||
}
|
||||
|
||||
static void check_code_address(cell address)
|
||||
void update_literal_and_word_references(code_block *compiled, factorvm *myvm)
|
||||
{
|
||||
return myvm->update_literal_and_word_references(compiled);
|
||||
}
|
||||
|
||||
void factorvm::check_code_address(cell address)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(address >= code.seg->start && address < code.seg->end);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
/* Update references to words. This is done after a new code block
|
||||
is added to the heap. */
|
||||
|
||||
/* Mark all literals referenced from a word XT. Only for tenured
|
||||
collections */
|
||||
void mark_code_block(code_block *compiled)
|
||||
void factorvm::mark_code_block(code_block *compiled)
|
||||
{
|
||||
check_code_address((cell)compiled);
|
||||
|
||||
|
@ -379,24 +434,31 @@ void mark_code_block(code_block *compiled)
|
|||
copy_handle(&compiled->relocation);
|
||||
}
|
||||
|
||||
void mark_stack_frame_step(stack_frame *frame)
|
||||
|
||||
void factorvm::mark_stack_frame_step(stack_frame *frame)
|
||||
{
|
||||
mark_code_block(frame_code(frame));
|
||||
}
|
||||
|
||||
void mark_stack_frame_step(stack_frame *frame, factorvm *myvm)
|
||||
{
|
||||
return myvm->mark_stack_frame_step(frame);
|
||||
}
|
||||
|
||||
/* Mark code blocks executing in currently active stack frames. */
|
||||
void mark_active_blocks(context *stacks)
|
||||
void factorvm::mark_active_blocks(context *stacks)
|
||||
{
|
||||
if(collecting_gen == data->tenured())
|
||||
{
|
||||
cell top = (cell)stacks->callstack_top;
|
||||
cell bottom = (cell)stacks->callstack_bottom;
|
||||
|
||||
iterate_callstack(top,bottom,mark_stack_frame_step);
|
||||
iterate_callstack(top,bottom,factor::mark_stack_frame_step);
|
||||
}
|
||||
}
|
||||
|
||||
void mark_object_code_block(object *object)
|
||||
|
||||
void factorvm::mark_object_code_block(object *object)
|
||||
{
|
||||
switch(object->h.hi_tag())
|
||||
{
|
||||
|
@ -419,23 +481,29 @@ void mark_object_code_block(object *object)
|
|||
case CALLSTACK_TYPE:
|
||||
{
|
||||
callstack *stack = (callstack *)object;
|
||||
iterate_callstack_object(stack,mark_stack_frame_step);
|
||||
iterate_callstack_object(stack,factor::mark_stack_frame_step);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Perform all fixups on a code block */
|
||||
void relocate_code_block(code_block *compiled)
|
||||
void factorvm::relocate_code_block(code_block *compiled)
|
||||
{
|
||||
compiled->last_scan = data->nursery();
|
||||
compiled->needs_fixup = false;
|
||||
iterate_relocations(compiled,relocate_code_block_step);
|
||||
iterate_relocations(compiled,factor::relocate_code_block_step);
|
||||
flush_icache_for(compiled);
|
||||
}
|
||||
|
||||
void relocate_code_block(code_block *compiled, factorvm *myvm)
|
||||
{
|
||||
return myvm->relocate_code_block(compiled);
|
||||
}
|
||||
|
||||
/* Fixup labels. This is done at compile time, not image load time */
|
||||
void fixup_labels(array *labels, code_block *compiled)
|
||||
void factorvm::fixup_labels(array *labels, code_block *compiled)
|
||||
{
|
||||
cell i;
|
||||
cell size = array_capacity(labels);
|
||||
|
@ -452,8 +520,9 @@ void fixup_labels(array *labels, code_block *compiled)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Might GC */
|
||||
code_block *allot_code_block(cell size)
|
||||
code_block *factorvm::allot_code_block(cell size)
|
||||
{
|
||||
heap_block *block = heap_allot(&code,size + sizeof(code_block));
|
||||
|
||||
|
@ -480,18 +549,14 @@ code_block *allot_code_block(cell size)
|
|||
return (code_block *)block;
|
||||
}
|
||||
|
||||
|
||||
/* Might GC */
|
||||
code_block *add_code_block(
|
||||
cell type,
|
||||
cell code_,
|
||||
cell labels_,
|
||||
cell relocation_,
|
||||
cell literals_)
|
||||
code_block *factorvm::add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_)
|
||||
{
|
||||
gc_root<byte_array> code(code_);
|
||||
gc_root<object> labels(labels_);
|
||||
gc_root<byte_array> relocation(relocation_);
|
||||
gc_root<array> literals(literals_);
|
||||
gc_root<byte_array> code(code_,this);
|
||||
gc_root<object> labels(labels_,this);
|
||||
gc_root<byte_array> relocation(relocation_,this);
|
||||
gc_root<array> literals(literals_,this);
|
||||
|
||||
cell code_length = align8(array_capacity(code.untagged()));
|
||||
code_block *compiled = allot_code_block(code_length);
|
||||
|
@ -522,4 +587,5 @@ code_block *add_code_block(
|
|||
return compiled;
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
|
|
@ -26,6 +26,8 @@ enum relocation_type {
|
|||
RT_UNTAGGED,
|
||||
/* address of megamorphic_cache_hits var */
|
||||
RT_MEGAMORPHIC_CACHE_HITS,
|
||||
/* address of vm object*/
|
||||
RT_VM,
|
||||
};
|
||||
|
||||
enum relocation_class {
|
||||
|
@ -60,37 +62,14 @@ static const cell rel_relative_arm_3_mask = 0xffffff;
|
|||
/* code relocation table consists of a table of entries for each fixup */
|
||||
typedef u32 relocation_entry;
|
||||
|
||||
void flush_icache_for(code_block *compiled);
|
||||
struct factorvm;
|
||||
|
||||
typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled);
|
||||
typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled, factorvm *vm);
|
||||
|
||||
void iterate_relocations(code_block *compiled, relocation_iterator iter);
|
||||
|
||||
void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
|
||||
|
||||
void relocate_code_block(code_block *compiled);
|
||||
|
||||
void update_literal_references(code_block *compiled);
|
||||
|
||||
void copy_literal_references(code_block *compiled);
|
||||
|
||||
void update_word_references(code_block *compiled);
|
||||
|
||||
void update_literal_and_word_references(code_block *compiled);
|
||||
|
||||
void mark_code_block(code_block *compiled);
|
||||
|
||||
void mark_active_blocks(context *stacks);
|
||||
|
||||
void mark_object_code_block(object *scan);
|
||||
|
||||
void relocate_code_block(code_block *relocating);
|
||||
|
||||
inline static bool stack_traces_p()
|
||||
{
|
||||
return userenv[STACK_TRACES_ENV] != F;
|
||||
}
|
||||
|
||||
code_block *add_code_block(cell type, cell code, cell labels, cell relocation, cell literals);
|
||||
// callback functions
|
||||
void relocate_code_block(code_block *compiled, factorvm *myvm);
|
||||
void copy_literal_references(code_block *compiled, factorvm *myvm);
|
||||
void update_word_references(code_block *compiled, factorvm *myvm);
|
||||
void update_literal_and_word_references(code_block *compiled, factorvm *myvm);
|
||||
|
||||
}
|
||||
|
|
|
@ -3,15 +3,16 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
static void clear_free_list(heap *heap)
|
||||
void factorvm::clear_free_list(heap *heap)
|
||||
{
|
||||
memset(&heap->free,0,sizeof(heap_free_list));
|
||||
}
|
||||
|
||||
|
||||
/* This malloc-style heap code is reasonably generic. Maybe in the future, it
|
||||
will be used for the data heap too, if we ever get incremental
|
||||
mark/sweep/compact GC. */
|
||||
void new_heap(heap *heap, cell size)
|
||||
void factorvm::new_heap(heap *heap, cell size)
|
||||
{
|
||||
heap->seg = alloc_segment(align_page(size));
|
||||
if(!heap->seg)
|
||||
|
@ -20,7 +21,8 @@ void new_heap(heap *heap, cell size)
|
|||
clear_free_list(heap);
|
||||
}
|
||||
|
||||
static void add_to_free_list(heap *heap, free_heap_block *block)
|
||||
|
||||
void factorvm::add_to_free_list(heap *heap, free_heap_block *block)
|
||||
{
|
||||
if(block->size < free_list_count * block_size_increment)
|
||||
{
|
||||
|
@ -35,11 +37,12 @@ static void add_to_free_list(heap *heap, free_heap_block *block)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Called after reading the code heap from the image file, and after code GC.
|
||||
|
||||
In the former case, we must add a large free block from compiling.base + size to
|
||||
compiling.limit. */
|
||||
void build_free_list(heap *heap, cell size)
|
||||
void factorvm::build_free_list(heap *heap, cell size)
|
||||
{
|
||||
heap_block *prev = NULL;
|
||||
|
||||
|
@ -91,13 +94,15 @@ void build_free_list(heap *heap, cell size)
|
|||
|
||||
}
|
||||
|
||||
static void assert_free_block(free_heap_block *block)
|
||||
|
||||
void factorvm::assert_free_block(free_heap_block *block)
|
||||
{
|
||||
if(block->status != B_FREE)
|
||||
critical_error("Invalid block in free list",(cell)block);
|
||||
}
|
||||
|
||||
|
||||
static free_heap_block *find_free_block(heap *heap, cell size)
|
||||
free_heap_block *factorvm::find_free_block(heap *heap, cell size)
|
||||
{
|
||||
cell attempt = size;
|
||||
|
||||
|
@ -137,7 +142,8 @@ static free_heap_block *find_free_block(heap *heap, cell size)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size)
|
||||
|
||||
free_heap_block *factorvm::split_free_block(heap *heap, free_heap_block *block, cell size)
|
||||
{
|
||||
if(block->size != size )
|
||||
{
|
||||
|
@ -153,8 +159,9 @@ static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cel
|
|||
return block;
|
||||
}
|
||||
|
||||
|
||||
/* Allocate a block of memory from the mark and sweep GC heap */
|
||||
heap_block *heap_allot(heap *heap, cell size)
|
||||
heap_block *factorvm::heap_allot(heap *heap, cell size)
|
||||
{
|
||||
size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
|
||||
|
||||
|
@ -170,14 +177,16 @@ heap_block *heap_allot(heap *heap, cell size)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
/* Deallocates a block manually */
|
||||
void heap_free(heap *heap, heap_block *block)
|
||||
void factorvm::heap_free(heap *heap, heap_block *block)
|
||||
{
|
||||
block->status = B_FREE;
|
||||
add_to_free_list(heap,(free_heap_block *)block);
|
||||
}
|
||||
|
||||
void mark_block(heap_block *block)
|
||||
|
||||
void factorvm::mark_block(heap_block *block)
|
||||
{
|
||||
/* If already marked, do nothing */
|
||||
switch(block->status)
|
||||
|
@ -193,9 +202,10 @@ void mark_block(heap_block *block)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* If in the middle of code GC, we have to grow the heap, data GC restarts from
|
||||
scratch, so we have to unmark any marked blocks. */
|
||||
void unmark_marked(heap *heap)
|
||||
void factorvm::unmark_marked(heap *heap)
|
||||
{
|
||||
heap_block *scan = first_block(heap);
|
||||
|
||||
|
@ -208,9 +218,10 @@ void unmark_marked(heap *heap)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* After code GC, all referenced code blocks have status set to B_MARKED, so any
|
||||
which are allocated and not marked can be reclaimed. */
|
||||
void free_unmarked(heap *heap, heap_iterator iter)
|
||||
void factorvm::free_unmarked(heap *heap, heap_iterator iter)
|
||||
{
|
||||
clear_free_list(heap);
|
||||
|
||||
|
@ -244,7 +255,7 @@ void free_unmarked(heap *heap, heap_iterator iter)
|
|||
add_to_free_list(heap,(free_heap_block *)prev);
|
||||
scan->status = B_ALLOCATED;
|
||||
prev = scan;
|
||||
iter(scan);
|
||||
iter(scan,this);
|
||||
break;
|
||||
default:
|
||||
critical_error("Invalid scan->status",(cell)scan);
|
||||
|
@ -257,8 +268,9 @@ void free_unmarked(heap *heap, heap_iterator iter)
|
|||
add_to_free_list(heap,(free_heap_block *)prev);
|
||||
}
|
||||
|
||||
|
||||
/* Compute total sum of sizes of free blocks, and size of largest free block */
|
||||
void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
|
||||
void factorvm::heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
|
||||
{
|
||||
*used = 0;
|
||||
*total_free = 0;
|
||||
|
@ -286,8 +298,9 @@ void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* The size of the heap, not including the last block if it's free */
|
||||
cell heap_size(heap *heap)
|
||||
cell factorvm::heap_size(heap *heap)
|
||||
{
|
||||
heap_block *scan = first_block(heap);
|
||||
|
||||
|
@ -302,8 +315,9 @@ cell heap_size(heap *heap)
|
|||
return heap->seg->size;
|
||||
}
|
||||
|
||||
|
||||
/* Compute where each block is going to go, after compaction */
|
||||
cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
||||
cell factorvm::compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
||||
{
|
||||
heap_block *scan = first_block(heap);
|
||||
char *address = (char *)first_block(heap);
|
||||
|
@ -324,7 +338,8 @@ cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &for
|
|||
return (cell)address - heap->seg->start;
|
||||
}
|
||||
|
||||
void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
||||
|
||||
void factorvm::compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
||||
{
|
||||
heap_block *scan = first_block(heap);
|
||||
|
||||
|
|
|
@ -14,19 +14,7 @@ struct heap {
|
|||
heap_free_list free;
|
||||
};
|
||||
|
||||
typedef void (*heap_iterator)(heap_block *compiled);
|
||||
|
||||
void new_heap(heap *h, cell size);
|
||||
void build_free_list(heap *h, cell size);
|
||||
heap_block *heap_allot(heap *h, cell size);
|
||||
void heap_free(heap *h, heap_block *block);
|
||||
void mark_block(heap_block *block);
|
||||
void unmark_marked(heap *heap);
|
||||
void free_unmarked(heap *heap, heap_iterator iter);
|
||||
void heap_usage(heap *h, cell *used, cell *total_free, cell *max_free);
|
||||
cell heap_size(heap *h);
|
||||
cell compute_heap_forwarding(heap *h, unordered_map<heap_block *,char *> &forwarding);
|
||||
void compact_heap(heap *h, unordered_map<heap_block *,char *> &forwarding);
|
||||
typedef void (*heap_iterator)(heap_block *compiled,factorvm *vm);
|
||||
|
||||
inline static heap_block *next_block(heap *h, heap_block *block)
|
||||
{
|
||||
|
|
|
@ -3,24 +3,22 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
heap code;
|
||||
|
||||
/* Allocate a code heap during startup */
|
||||
void init_code_heap(cell size)
|
||||
void factorvm::init_code_heap(cell size)
|
||||
{
|
||||
new_heap(&code,size);
|
||||
}
|
||||
|
||||
bool in_code_heap_p(cell ptr)
|
||||
bool factorvm::in_code_heap_p(cell ptr)
|
||||
{
|
||||
return (ptr >= code.seg->start && ptr <= code.seg->end);
|
||||
}
|
||||
|
||||
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
|
||||
void jit_compile_word(cell word_, cell def_, bool relocate)
|
||||
void factorvm::jit_compile_word(cell word_, cell def_, bool relocate)
|
||||
{
|
||||
gc_root<word> word(word_);
|
||||
gc_root<quotation> def(def_);
|
||||
gc_root<word> word(word_,this);
|
||||
gc_root<quotation> def(def_,this);
|
||||
|
||||
jit_compile(def.value(),relocate);
|
||||
|
||||
|
@ -30,36 +28,40 @@ void jit_compile_word(cell word_, cell def_, bool relocate)
|
|||
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
|
||||
}
|
||||
|
||||
|
||||
/* Apply a function to every code block */
|
||||
void iterate_code_heap(code_heap_iterator iter)
|
||||
void factorvm::iterate_code_heap(code_heap_iterator iter)
|
||||
{
|
||||
heap_block *scan = first_block(&code);
|
||||
|
||||
while(scan)
|
||||
{
|
||||
if(scan->status != B_FREE)
|
||||
iter((code_block *)scan);
|
||||
iter((code_block *)scan,this);
|
||||
scan = next_block(&code,scan);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Copy literals referenced from all code blocks to newspace. Only for
|
||||
aging and nursery collections */
|
||||
void copy_code_heap_roots()
|
||||
void factorvm::copy_code_heap_roots()
|
||||
{
|
||||
iterate_code_heap(copy_literal_references);
|
||||
iterate_code_heap(factor::copy_literal_references);
|
||||
}
|
||||
|
||||
|
||||
/* Update pointers to words referenced from all code blocks. Only after
|
||||
defining a new word. */
|
||||
void update_code_heap_words()
|
||||
void factorvm::update_code_heap_words()
|
||||
{
|
||||
iterate_code_heap(update_word_references);
|
||||
iterate_code_heap(factor::update_word_references);
|
||||
}
|
||||
|
||||
PRIMITIVE(modify_code_heap)
|
||||
|
||||
inline void factorvm::vmprim_modify_code_heap()
|
||||
{
|
||||
gc_root<array> alist(dpop());
|
||||
gc_root<array> alist(dpop(),this);
|
||||
|
||||
cell count = array_capacity(alist.untagged());
|
||||
|
||||
|
@ -69,10 +71,10 @@ PRIMITIVE(modify_code_heap)
|
|||
cell i;
|
||||
for(i = 0; i < count; i++)
|
||||
{
|
||||
gc_root<array> pair(array_nth(alist.untagged(),i));
|
||||
gc_root<array> pair(array_nth(alist.untagged(),i),this);
|
||||
|
||||
gc_root<word> word(array_nth(pair.untagged(),0));
|
||||
gc_root<object> data(array_nth(pair.untagged(),1));
|
||||
gc_root<word> word(array_nth(pair.untagged(),0),this);
|
||||
gc_root<object> data(array_nth(pair.untagged(),1),this);
|
||||
|
||||
switch(data.type())
|
||||
{
|
||||
|
@ -108,8 +110,13 @@ PRIMITIVE(modify_code_heap)
|
|||
update_code_heap_words();
|
||||
}
|
||||
|
||||
PRIMITIVE(modify_code_heap)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_modify_code_heap();
|
||||
}
|
||||
|
||||
/* Push the free space and total size of the code heap */
|
||||
PRIMITIVE(code_room)
|
||||
inline void factorvm::vmprim_code_room()
|
||||
{
|
||||
cell used, total_free, max_free;
|
||||
heap_usage(&code,&used,&total_free,&max_free);
|
||||
|
@ -119,14 +126,19 @@ PRIMITIVE(code_room)
|
|||
dpush(tag_fixnum(max_free / 1024));
|
||||
}
|
||||
|
||||
static unordered_map<heap_block *,char *> forwarding;
|
||||
PRIMITIVE(code_room)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_code_room();
|
||||
}
|
||||
|
||||
code_block *forward_xt(code_block *compiled)
|
||||
|
||||
code_block *factorvm::forward_xt(code_block *compiled)
|
||||
{
|
||||
return (code_block *)forwarding[compiled];
|
||||
}
|
||||
|
||||
void forward_frame_xt(stack_frame *frame)
|
||||
|
||||
void factorvm::forward_frame_xt(stack_frame *frame)
|
||||
{
|
||||
cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
|
||||
code_block *forwarded = forward_xt(frame_code(frame));
|
||||
|
@ -134,7 +146,12 @@ void forward_frame_xt(stack_frame *frame)
|
|||
FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
|
||||
}
|
||||
|
||||
void forward_object_xts()
|
||||
void forward_frame_xt(stack_frame *frame,factorvm *myvm)
|
||||
{
|
||||
return myvm->forward_frame_xt(frame);
|
||||
}
|
||||
|
||||
void factorvm::forward_object_xts()
|
||||
{
|
||||
begin_scan();
|
||||
|
||||
|
@ -165,7 +182,7 @@ void forward_object_xts()
|
|||
case CALLSTACK_TYPE:
|
||||
{
|
||||
callstack *stack = untag<callstack>(obj);
|
||||
iterate_callstack_object(stack,forward_frame_xt);
|
||||
iterate_callstack_object(stack,factor::forward_frame_xt);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
|
@ -176,8 +193,9 @@ void forward_object_xts()
|
|||
end_scan();
|
||||
}
|
||||
|
||||
|
||||
/* Set the XT fields now that the heap has been compacted */
|
||||
void fixup_object_xts()
|
||||
void factorvm::fixup_object_xts()
|
||||
{
|
||||
begin_scan();
|
||||
|
||||
|
@ -205,11 +223,12 @@ void fixup_object_xts()
|
|||
end_scan();
|
||||
}
|
||||
|
||||
|
||||
/* Move all free space to the end of the code heap. This is not very efficient,
|
||||
since it makes several passes over the code and data heaps, but we only ever
|
||||
do this before saving a deployed image and exiting, so performaance is not
|
||||
critical here */
|
||||
void compact_code_heap()
|
||||
void factorvm::compact_code_heap()
|
||||
{
|
||||
/* Free all unreachable code blocks */
|
||||
gc();
|
||||
|
|
|
@ -1,32 +1,9 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
/* compiled code */
|
||||
extern heap code;
|
||||
|
||||
void init_code_heap(cell size);
|
||||
|
||||
bool in_code_heap_p(cell ptr);
|
||||
|
||||
void jit_compile_word(cell word, cell def, bool relocate);
|
||||
|
||||
typedef void (*code_heap_iterator)(code_block *compiled);
|
||||
|
||||
void iterate_code_heap(code_heap_iterator iter);
|
||||
|
||||
void copy_code_heap_roots();
|
||||
struct factorvm;
|
||||
typedef void (*code_heap_iterator)(code_block *compiled,factorvm *myvm);
|
||||
|
||||
PRIMITIVE(modify_code_heap);
|
||||
|
||||
PRIMITIVE(code_room);
|
||||
|
||||
void compact_code_heap();
|
||||
|
||||
inline static void check_code_pointer(cell ptr)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(in_code_heap_p(ptr));
|
||||
#endif
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,26 +1,22 @@
|
|||
#include "master.hpp"
|
||||
|
||||
factor::context *stack_chain;
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
cell ds_size, rs_size;
|
||||
context *unused_contexts;
|
||||
|
||||
void reset_datastack()
|
||||
void factorvm::reset_datastack()
|
||||
{
|
||||
ds = ds_bot - sizeof(cell);
|
||||
}
|
||||
|
||||
void reset_retainstack()
|
||||
void factorvm::reset_retainstack()
|
||||
{
|
||||
rs = rs_bot - sizeof(cell);
|
||||
}
|
||||
|
||||
static const cell stack_reserved = (64 * sizeof(cell));
|
||||
|
||||
void fix_stacks()
|
||||
void factorvm::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();
|
||||
|
@ -28,7 +24,7 @@ void fix_stacks()
|
|||
|
||||
/* 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 save_stacks()
|
||||
void factorvm::save_stacks()
|
||||
{
|
||||
if(stack_chain)
|
||||
{
|
||||
|
@ -37,7 +33,7 @@ void save_stacks()
|
|||
}
|
||||
}
|
||||
|
||||
context *alloc_context()
|
||||
context *factorvm::alloc_context()
|
||||
{
|
||||
context *new_context;
|
||||
|
||||
|
@ -56,14 +52,14 @@ context *alloc_context()
|
|||
return new_context;
|
||||
}
|
||||
|
||||
void dealloc_context(context *old_context)
|
||||
void factorvm::dealloc_context(context *old_context)
|
||||
{
|
||||
old_context->next = unused_contexts;
|
||||
unused_contexts = old_context;
|
||||
}
|
||||
|
||||
/* called on entry into a compiled callback */
|
||||
void nest_stacks()
|
||||
void factorvm::nest_stacks()
|
||||
{
|
||||
context *new_context = alloc_context();
|
||||
|
||||
|
@ -94,8 +90,14 @@ void nest_stacks()
|
|||
reset_retainstack();
|
||||
}
|
||||
|
||||
void nest_stacks(factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->nest_stacks();
|
||||
}
|
||||
|
||||
/* called when leaving a compiled callback */
|
||||
void unnest_stacks()
|
||||
void factorvm::unnest_stacks()
|
||||
{
|
||||
ds = stack_chain->datastack_save;
|
||||
rs = stack_chain->retainstack_save;
|
||||
|
@ -109,8 +111,14 @@ void unnest_stacks()
|
|||
dealloc_context(old_stacks);
|
||||
}
|
||||
|
||||
void unnest_stacks(factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->unnest_stacks();
|
||||
}
|
||||
|
||||
/* called on startup */
|
||||
void init_stacks(cell ds_size_, cell rs_size_)
|
||||
void factorvm::init_stacks(cell ds_size_, cell rs_size_)
|
||||
{
|
||||
ds_size = ds_size_;
|
||||
rs_size = rs_size_;
|
||||
|
@ -118,7 +126,7 @@ void init_stacks(cell ds_size_, cell rs_size_)
|
|||
unused_contexts = NULL;
|
||||
}
|
||||
|
||||
bool stack_to_array(cell bottom, cell top)
|
||||
bool factorvm::stack_to_array(cell bottom, cell top)
|
||||
{
|
||||
fixnum depth = (fixnum)(top - bottom + sizeof(cell));
|
||||
|
||||
|
@ -133,38 +141,58 @@ bool stack_to_array(cell bottom, cell top)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(datastack)
|
||||
inline void factorvm::vmprim_datastack()
|
||||
{
|
||||
if(!stack_to_array(ds_bot,ds))
|
||||
general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
|
||||
}
|
||||
|
||||
PRIMITIVE(retainstack)
|
||||
PRIMITIVE(datastack)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_datastack();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_retainstack()
|
||||
{
|
||||
if(!stack_to_array(rs_bot,rs))
|
||||
general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
|
||||
}
|
||||
|
||||
PRIMITIVE(retainstack)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_retainstack();
|
||||
}
|
||||
|
||||
/* returns pointer to top of stack */
|
||||
cell array_to_stack(array *array, cell bottom)
|
||||
cell factorvm::array_to_stack(array *array, cell bottom)
|
||||
{
|
||||
cell depth = array_capacity(array) * sizeof(cell);
|
||||
memcpy((void*)bottom,array + 1,depth);
|
||||
return bottom + depth - sizeof(cell);
|
||||
}
|
||||
|
||||
PRIMITIVE(set_datastack)
|
||||
inline void factorvm::vmprim_set_datastack()
|
||||
{
|
||||
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
|
||||
}
|
||||
|
||||
PRIMITIVE(set_retainstack)
|
||||
PRIMITIVE(set_datastack)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_set_datastack();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_set_retainstack()
|
||||
{
|
||||
rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
|
||||
}
|
||||
|
||||
PRIMITIVE(set_retainstack)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_set_retainstack();
|
||||
}
|
||||
|
||||
/* Used to implement call( */
|
||||
PRIMITIVE(check_datastack)
|
||||
inline void factorvm::vmprim_check_datastack()
|
||||
{
|
||||
fixnum out = to_fixnum(dpop());
|
||||
fixnum in = to_fixnum(dpop());
|
||||
|
@ -189,4 +217,9 @@ PRIMITIVE(check_datastack)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(check_datastack)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_check_datastack();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -36,8 +36,6 @@ struct context {
|
|||
context *next;
|
||||
};
|
||||
|
||||
extern cell ds_size, rs_size;
|
||||
|
||||
#define ds_bot (stack_chain->datastack_region->start)
|
||||
#define ds_top (stack_chain->datastack_region->end)
|
||||
#define rs_bot (stack_chain->retainstack_region->start)
|
||||
|
@ -46,21 +44,15 @@ extern cell ds_size, rs_size;
|
|||
DEFPUSHPOP(d,ds)
|
||||
DEFPUSHPOP(r,rs)
|
||||
|
||||
void reset_datastack();
|
||||
void reset_retainstack();
|
||||
void fix_stacks();
|
||||
void init_stacks(cell ds_size, cell rs_size);
|
||||
|
||||
PRIMITIVE(datastack);
|
||||
PRIMITIVE(retainstack);
|
||||
PRIMITIVE(set_datastack);
|
||||
PRIMITIVE(set_retainstack);
|
||||
PRIMITIVE(check_datastack);
|
||||
|
||||
VM_C_API void save_stacks();
|
||||
VM_C_API void nest_stacks();
|
||||
VM_C_API void unnest_stacks();
|
||||
struct factorvm;
|
||||
VM_C_API void nest_stacks(factorvm *vm);
|
||||
VM_C_API void unnest_stacks(factorvm *vm);
|
||||
|
||||
}
|
||||
|
||||
VM_C_API factor::context *stack_chain;
|
||||
|
|
|
@ -3,6 +3,7 @@ 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");
|
||||
|
@ -81,9 +82,9 @@ inline static unsigned int fpu_status(unsigned int status)
|
|||
}
|
||||
|
||||
/* Defined in assembly */
|
||||
VM_ASM_API void c_to_factor(cell quot);
|
||||
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind);
|
||||
VM_ASM_API void lazy_jit_compile(cell quot);
|
||||
VM_ASM_API void c_to_factor(cell quot, void *vm);
|
||||
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind, void *vm);
|
||||
VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
|
||||
VM_ASM_API void flush_icache(cell start, cell len);
|
||||
|
||||
VM_ASM_API void set_callstack(stack_frame *to,
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
#define ARG0 %eax
|
||||
#define ARG1 %edx
|
||||
#define ARG2 %ecx
|
||||
#define STACK_REG %esp
|
||||
#define DS_REG %esi
|
||||
#define RETURN_REG %eax
|
||||
|
@ -48,13 +49,14 @@ DEF(long long,read_timestamp_counter,(void)):
|
|||
rdtsc
|
||||
ret
|
||||
|
||||
DEF(void,primitive_inline_cache_miss,(void)):
|
||||
DEF(void,primitive_inline_cache_miss,(void *vm)):
|
||||
mov (%esp),%ebx
|
||||
DEF(void,primitive_inline_cache_miss_tail,(void)):
|
||||
DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
|
||||
sub $8,%esp
|
||||
push ARG0 /* push vm ptr */
|
||||
push %ebx
|
||||
call MANGLE(inline_cache_miss)
|
||||
add $12,%esp
|
||||
add $16,%esp
|
||||
jmp *%eax
|
||||
|
||||
DEF(void,get_sse_env,(void*)):
|
||||
|
@ -79,6 +81,31 @@ DEF(void,set_x87_env,(const void*)):
|
|||
fldcw 2(%eax)
|
||||
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 */
|
||||
/* clear x87 stack, but preserve rounding mode and exception flags */
|
||||
sub $2,STACK_REG
|
||||
fnstcw (STACK_REG)
|
||||
fninit
|
||||
fldcw (STACK_REG)
|
||||
/* rewind_to */
|
||||
mov ARG1,STACK_REG
|
||||
mov NV_TEMP_REG,ARG1
|
||||
jmp *QUOT_XT_OFFSET(ARG0)
|
||||
|
||||
|
||||
DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
|
||||
mov ARG1,NV_TEMP_REG /* stash vm ptr */
|
||||
mov STACK_REG,ARG1 /* Save stack pointer */
|
||||
sub $STACK_PADDING,STACK_REG
|
||||
push NV_TEMP_REG /* push vm ptr as arg3 */
|
||||
call MANGLE(lazy_jit_compile_impl)
|
||||
pop NV_TEMP_REG
|
||||
mov RETURN_REG,ARG0 /* No-op on 32-bit */
|
||||
add $STACK_PADDING,STACK_REG
|
||||
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
||||
|
||||
|
||||
#include "cpu-x86.S"
|
||||
|
||||
#ifdef WINDOWS
|
||||
|
|
|
@ -7,5 +7,5 @@ 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)))
|
||||
}
|
||||
|
|
|
@ -79,15 +79,17 @@ DEF(long long,read_timestamp_counter,(void)):
|
|||
or %rdx,%rax
|
||||
ret
|
||||
|
||||
DEF(void,primitive_inline_cache_miss,(void)):
|
||||
DEF(void,primitive_inline_cache_miss,(void *vm)):
|
||||
mov (%rsp),%rbx
|
||||
DEF(void,primitive_inline_cache_miss_tail,(void)):
|
||||
DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
|
||||
sub $STACK_PADDING,%rsp
|
||||
mov ARG0,ARG1
|
||||
mov %rbx,ARG0
|
||||
call MANGLE(inline_cache_miss)
|
||||
add $STACK_PADDING,%rsp
|
||||
jmp *%rax
|
||||
|
||||
|
||||
DEF(void,get_sse_env,(void*)):
|
||||
stmxcsr (%rdi)
|
||||
ret
|
||||
|
@ -106,4 +108,25 @@ DEF(void,set_x87_env,(const void*)):
|
|||
fldcw 2(%rdi)
|
||||
ret
|
||||
|
||||
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
|
||||
/* clear x87 stack, but preserve rounding mode and exception flags */
|
||||
sub $2,STACK_REG
|
||||
fnstcw (STACK_REG)
|
||||
fninit
|
||||
fldcw (STACK_REG)
|
||||
/* rewind_to */
|
||||
mov ARG1,STACK_REG
|
||||
mov ARG2,ARG1 /* make vm ptr 2nd arg in case quot_xt = lazy_jit_compile */
|
||||
jmp *QUOT_XT_OFFSET(ARG0)
|
||||
|
||||
DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
|
||||
mov ARG1,ARG2 /* vm is 3rd arg */
|
||||
mov STACK_REG,ARG1 /* Save stack pointer */
|
||||
sub $STACK_PADDING,STACK_REG
|
||||
call MANGLE(lazy_jit_compile_impl)
|
||||
mov RETURN_REG,ARG0 /* No-op on 32-bit */
|
||||
add $STACK_PADDING,STACK_REG
|
||||
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
||||
|
||||
|
||||
#include "cpu-x86.S"
|
||||
|
|
|
@ -7,5 +7,5 @@ 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
|
||||
}
|
||||
|
|
38
vm/cpu-x86.S
38
vm/cpu-x86.S
|
@ -1,4 +1,5 @@
|
|||
DEF(void,primitive_fixnum_add,(void)):
|
||||
DEF(void,primitive_fixnum_add,(void *myvm)):
|
||||
mov ARG0, ARG2 /* save vm ptr for overflow */
|
||||
mov (DS_REG),ARG0
|
||||
mov -CELL_SIZE(DS_REG),ARG1
|
||||
sub $CELL_SIZE,DS_REG
|
||||
|
@ -8,7 +9,8 @@ DEF(void,primitive_fixnum_add,(void)):
|
|||
mov ARITH_TEMP_1,(DS_REG)
|
||||
ret
|
||||
|
||||
DEF(void,primitive_fixnum_subtract,(void)):
|
||||
DEF(void,primitive_fixnum_subtract,(void *myvm)):
|
||||
mov ARG0, ARG2 /* save vm ptr for overflow */
|
||||
mov (DS_REG),ARG1
|
||||
mov -CELL_SIZE(DS_REG),ARG0
|
||||
sub $CELL_SIZE,DS_REG
|
||||
|
@ -18,7 +20,8 @@ DEF(void,primitive_fixnum_subtract,(void)):
|
|||
mov ARITH_TEMP_1,(DS_REG)
|
||||
ret
|
||||
|
||||
DEF(void,primitive_fixnum_multiply,(void)):
|
||||
DEF(void,primitive_fixnum_multiply,(void *myvm)):
|
||||
push ARG0 /* save vm ptr for overflow */
|
||||
mov (DS_REG),ARITH_TEMP_1
|
||||
mov ARITH_TEMP_1,DIV_RESULT
|
||||
mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
|
||||
|
@ -27,24 +30,28 @@ DEF(void,primitive_fixnum_multiply,(void)):
|
|||
imul ARITH_TEMP_2
|
||||
jo multiply_overflow
|
||||
mov DIV_RESULT,(DS_REG)
|
||||
pop ARG2
|
||||
ret
|
||||
multiply_overflow:
|
||||
sar $3,ARITH_TEMP_1
|
||||
mov ARITH_TEMP_1,ARG0
|
||||
mov ARITH_TEMP_2,ARG1
|
||||
pop ARG2
|
||||
jmp MANGLE(overflow_fixnum_multiply)
|
||||
|
||||
DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
|
||||
|
||||
DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
|
||||
PUSH_NONVOLATILE
|
||||
mov ARG0,NV_TEMP_REG
|
||||
|
||||
/* Create register shadow area for Win64 */
|
||||
sub $32,STACK_REG
|
||||
|
||||
/* Save stack pointer */
|
||||
lea -CELL_SIZE(STACK_REG),ARG0
|
||||
push ARG1 /* save vm ptr */
|
||||
call MANGLE(save_callstack_bottom)
|
||||
|
||||
pop ARG1
|
||||
|
||||
/* Call quot-xt */
|
||||
mov NV_TEMP_REG,ARG0
|
||||
call *QUOT_XT_OFFSET(ARG0)
|
||||
|
@ -55,24 +62,6 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
|
|||
POP_NONVOLATILE
|
||||
ret
|
||||
|
||||
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
|
||||
/* clear x87 stack, but preserve rounding mode and exception flags */
|
||||
sub $2,STACK_REG
|
||||
fnstcw (STACK_REG)
|
||||
fninit
|
||||
fldcw (STACK_REG)
|
||||
/* rewind_to */
|
||||
mov ARG1,STACK_REG
|
||||
jmp *QUOT_XT_OFFSET(ARG0)
|
||||
|
||||
DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot)):
|
||||
mov STACK_REG,ARG1 /* Save stack pointer */
|
||||
sub $STACK_PADDING,STACK_REG
|
||||
call MANGLE(lazy_jit_compile_impl)
|
||||
mov RETURN_REG,ARG0 /* No-op on 32-bit */
|
||||
add $STACK_PADDING,STACK_REG
|
||||
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
||||
|
||||
/* cpu.x86.features calls this */
|
||||
DEF(bool,sse_version,(void)):
|
||||
mov $0x1,RETURN_REG
|
||||
|
@ -109,6 +98,7 @@ sse_2:
|
|||
sse_1:
|
||||
mov $10,RETURN_REG
|
||||
ret
|
||||
|
||||
#ifdef WINDOWS
|
||||
.section .drectve
|
||||
.ascii " -export:sse_version"
|
||||
|
|
|
@ -69,9 +69,9 @@ inline static unsigned int fpu_status(unsigned int status)
|
|||
}
|
||||
|
||||
/* Defined in assembly */
|
||||
VM_ASM_API void c_to_factor(cell quot);
|
||||
VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to);
|
||||
VM_ASM_API void lazy_jit_compile(cell quot);
|
||||
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);
|
||||
|
||||
VM_C_API void set_callstack(stack_frame *to,
|
||||
stack_frame *from,
|
||||
|
|
|
@ -3,45 +3,16 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
/* used during garbage collection only */
|
||||
zone *newspace;
|
||||
bool performing_gc;
|
||||
bool performing_compaction;
|
||||
cell collecting_gen;
|
||||
|
||||
/* if true, we are collecting aging space for the second time, so if it is still
|
||||
full, we go on to collect tenured */
|
||||
bool collecting_aging_again;
|
||||
|
||||
/* in case a generation fills up in the middle of a gc, we jump back
|
||||
up to try collecting the next generation. */
|
||||
jmp_buf gc_jmp;
|
||||
|
||||
gc_stats stats[max_gen_count];
|
||||
u64 cards_scanned;
|
||||
u64 decks_scanned;
|
||||
u64 card_scan_time;
|
||||
cell code_heap_scans;
|
||||
|
||||
/* What generation was being collected when copy_code_heap_roots() was last
|
||||
called? Until the next call to add_code_block(), future
|
||||
collections of younger generations don't have to touch the code
|
||||
heap. */
|
||||
cell last_code_heap_scan;
|
||||
|
||||
/* sometimes we grow the heap */
|
||||
bool growing_data_heap;
|
||||
data_heap *old_data_heap;
|
||||
|
||||
void init_data_gc()
|
||||
void factorvm::init_data_gc()
|
||||
{
|
||||
performing_gc = false;
|
||||
last_code_heap_scan = data->nursery();
|
||||
collecting_aging_again = false;
|
||||
}
|
||||
|
||||
|
||||
/* Given a pointer to oldspace, copy it to newspace */
|
||||
static object *copy_untagged_object_impl(object *pointer, cell size)
|
||||
object *factorvm::copy_untagged_object_impl(object *pointer, cell size)
|
||||
{
|
||||
if(newspace->here + size >= newspace->end)
|
||||
longjmp(gc_jmp,1);
|
||||
|
@ -55,14 +26,16 @@ static object *copy_untagged_object_impl(object *pointer, cell size)
|
|||
return newpointer;
|
||||
}
|
||||
|
||||
static object *copy_object_impl(object *untagged)
|
||||
|
||||
object *factorvm::copy_object_impl(object *untagged)
|
||||
{
|
||||
object *newpointer = copy_untagged_object_impl(untagged,untagged_object_size(untagged));
|
||||
untagged->h.forward_to(newpointer);
|
||||
return newpointer;
|
||||
}
|
||||
|
||||
static bool should_copy_p(object *untagged)
|
||||
|
||||
bool factorvm::should_copy_p(object *untagged)
|
||||
{
|
||||
if(in_zone(newspace,untagged))
|
||||
return false;
|
||||
|
@ -79,8 +52,9 @@ static bool should_copy_p(object *untagged)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Follow a chain of forwarding pointers */
|
||||
static object *resolve_forwarding(object *untagged)
|
||||
object *factorvm::resolve_forwarding(object *untagged)
|
||||
{
|
||||
check_data_pointer(untagged);
|
||||
|
||||
|
@ -98,27 +72,30 @@ static object *resolve_forwarding(object *untagged)
|
|||
}
|
||||
}
|
||||
|
||||
template <typename T> static T *copy_untagged_object(T *untagged)
|
||||
|
||||
template <typename TYPE> TYPE *factorvm::copy_untagged_object(TYPE *untagged)
|
||||
{
|
||||
check_data_pointer(untagged);
|
||||
|
||||
if(untagged->h.forwarding_pointer_p())
|
||||
untagged = (T *)resolve_forwarding(untagged->h.forwarding_pointer());
|
||||
untagged = (TYPE *)resolve_forwarding(untagged->h.forwarding_pointer());
|
||||
else
|
||||
{
|
||||
untagged->h.check_header();
|
||||
untagged = (T *)copy_object_impl(untagged);
|
||||
untagged = (TYPE *)copy_object_impl(untagged);
|
||||
}
|
||||
|
||||
return untagged;
|
||||
}
|
||||
|
||||
static cell copy_object(cell pointer)
|
||||
|
||||
cell factorvm::copy_object(cell pointer)
|
||||
{
|
||||
return RETAG(copy_untagged_object(untag<object>(pointer)),TAG(pointer));
|
||||
}
|
||||
|
||||
void copy_handle(cell *handle)
|
||||
|
||||
void factorvm::copy_handle(cell *handle)
|
||||
{
|
||||
cell pointer = *handle;
|
||||
|
||||
|
@ -131,8 +108,9 @@ void copy_handle(cell *handle)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Scan all the objects in the card */
|
||||
static void copy_card(card *ptr, cell gen, cell here)
|
||||
void factorvm::copy_card(card *ptr, cell gen, cell here)
|
||||
{
|
||||
cell card_scan = card_to_addr(ptr) + card_offset(ptr);
|
||||
cell card_end = card_to_addr(ptr + 1);
|
||||
|
@ -145,7 +123,8 @@ static void copy_card(card *ptr, cell gen, cell here)
|
|||
cards_scanned++;
|
||||
}
|
||||
|
||||
static void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
|
||||
|
||||
void factorvm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
|
||||
{
|
||||
card *first_card = deck_to_card(deck);
|
||||
card *last_card = deck_to_card(deck + 1);
|
||||
|
@ -176,8 +155,9 @@ static void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
|
|||
decks_scanned++;
|
||||
}
|
||||
|
||||
|
||||
/* Copy all newspace objects referenced from marked cards to the destination */
|
||||
static void copy_gen_cards(cell gen)
|
||||
void factorvm::copy_gen_cards(cell gen)
|
||||
{
|
||||
card_deck *first_deck = addr_to_deck(data->generations[gen].start);
|
||||
card_deck *last_deck = addr_to_deck(data->generations[gen].end);
|
||||
|
@ -242,9 +222,10 @@ static void copy_gen_cards(cell gen)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Scan cards in all generations older than the one being collected, copying
|
||||
old->new references */
|
||||
static void copy_cards()
|
||||
void factorvm::copy_cards()
|
||||
{
|
||||
u64 start = current_micros();
|
||||
|
||||
|
@ -255,8 +236,9 @@ static void copy_cards()
|
|||
card_scan_time += (current_micros() - start);
|
||||
}
|
||||
|
||||
|
||||
/* Copy all tagged pointers in a range of memory */
|
||||
static void copy_stack_elements(segment *region, cell top)
|
||||
void factorvm::copy_stack_elements(segment *region, cell top)
|
||||
{
|
||||
cell ptr = region->start;
|
||||
|
||||
|
@ -264,7 +246,8 @@ static void copy_stack_elements(segment *region, cell top)
|
|||
copy_handle((cell*)ptr);
|
||||
}
|
||||
|
||||
static void copy_registered_locals()
|
||||
|
||||
void factorvm::copy_registered_locals()
|
||||
{
|
||||
std::vector<cell>::const_iterator iter = gc_locals.begin();
|
||||
std::vector<cell>::const_iterator end = gc_locals.end();
|
||||
|
@ -273,7 +256,8 @@ static void copy_registered_locals()
|
|||
copy_handle((cell *)(*iter));
|
||||
}
|
||||
|
||||
static void copy_registered_bignums()
|
||||
|
||||
void factorvm::copy_registered_bignums()
|
||||
{
|
||||
std::vector<cell>::const_iterator iter = gc_bignums.begin();
|
||||
std::vector<cell>::const_iterator end = gc_bignums.end();
|
||||
|
@ -295,9 +279,10 @@ static void copy_registered_bignums()
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Copy roots over at the start of GC, namely various constants, stacks,
|
||||
the user environment and extra roots registered by local_roots.hpp */
|
||||
static void copy_roots()
|
||||
void factorvm::copy_roots()
|
||||
{
|
||||
copy_handle(&T);
|
||||
copy_handle(&bignum_zero);
|
||||
|
@ -331,7 +316,8 @@ static void copy_roots()
|
|||
copy_handle(&userenv[i]);
|
||||
}
|
||||
|
||||
static cell copy_next_from_nursery(cell scan)
|
||||
|
||||
cell factorvm::copy_next_from_nursery(cell scan)
|
||||
{
|
||||
cell *obj = (cell *)scan;
|
||||
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
|
||||
|
@ -359,7 +345,8 @@ static cell copy_next_from_nursery(cell scan)
|
|||
return scan + untagged_object_size((object *)scan);
|
||||
}
|
||||
|
||||
static cell copy_next_from_aging(cell scan)
|
||||
|
||||
cell factorvm::copy_next_from_aging(cell scan)
|
||||
{
|
||||
cell *obj = (cell *)scan;
|
||||
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
|
||||
|
@ -391,7 +378,8 @@ static cell copy_next_from_aging(cell scan)
|
|||
return scan + untagged_object_size((object *)scan);
|
||||
}
|
||||
|
||||
static cell copy_next_from_tenured(cell scan)
|
||||
|
||||
cell factorvm::copy_next_from_tenured(cell scan)
|
||||
{
|
||||
cell *obj = (cell *)scan;
|
||||
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
|
||||
|
@ -421,7 +409,8 @@ static cell copy_next_from_tenured(cell scan)
|
|||
return scan + untagged_object_size((object *)scan);
|
||||
}
|
||||
|
||||
void copy_reachable_objects(cell scan, cell *end)
|
||||
|
||||
void factorvm::copy_reachable_objects(cell scan, cell *end)
|
||||
{
|
||||
if(collecting_gen == data->nursery())
|
||||
{
|
||||
|
@ -440,8 +429,9 @@ void copy_reachable_objects(cell scan, cell *end)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Prepare to start copying reachable objects into an unused zone */
|
||||
static void begin_gc(cell requested_bytes)
|
||||
void factorvm::begin_gc(cell requested_bytes)
|
||||
{
|
||||
if(growing_data_heap)
|
||||
{
|
||||
|
@ -474,7 +464,8 @@ static void begin_gc(cell requested_bytes)
|
|||
}
|
||||
}
|
||||
|
||||
static void end_gc(cell gc_elapsed)
|
||||
|
||||
void factorvm::end_gc(cell gc_elapsed)
|
||||
{
|
||||
gc_stats *s = &stats[collecting_gen];
|
||||
|
||||
|
@ -512,12 +503,11 @@ static void end_gc(cell gc_elapsed)
|
|||
collecting_aging_again = false;
|
||||
}
|
||||
|
||||
|
||||
/* Collect gen and all younger generations.
|
||||
If growing_data_heap_ is true, we must grow the data heap to such a size that
|
||||
an allocation of requested_bytes won't fail */
|
||||
void garbage_collection(cell gen,
|
||||
bool growing_data_heap_,
|
||||
cell requested_bytes)
|
||||
void factorvm::garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes)
|
||||
{
|
||||
if(gc_off)
|
||||
{
|
||||
|
@ -578,7 +568,7 @@ void garbage_collection(cell gen,
|
|||
code_heap_scans++;
|
||||
|
||||
if(collecting_gen == data->tenured())
|
||||
free_unmarked(&code,(heap_iterator)update_literal_and_word_references);
|
||||
free_unmarked(&code,(heap_iterator)factor::update_literal_and_word_references);
|
||||
else
|
||||
copy_code_heap_roots();
|
||||
|
||||
|
@ -595,19 +585,26 @@ void garbage_collection(cell gen,
|
|||
performing_gc = false;
|
||||
}
|
||||
|
||||
void gc()
|
||||
|
||||
void factorvm::gc()
|
||||
{
|
||||
garbage_collection(data->tenured(),false,0);
|
||||
}
|
||||
|
||||
PRIMITIVE(gc)
|
||||
|
||||
inline void factorvm::vmprim_gc()
|
||||
{
|
||||
gc();
|
||||
}
|
||||
|
||||
PRIMITIVE(gc_stats)
|
||||
PRIMITIVE(gc)
|
||||
{
|
||||
growable_array result;
|
||||
PRIMITIVE_GETVM()->vmprim_gc();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_gc_stats()
|
||||
{
|
||||
growable_array result(this);
|
||||
|
||||
cell i;
|
||||
u64 total_gc_time = 0;
|
||||
|
@ -635,7 +632,12 @@ PRIMITIVE(gc_stats)
|
|||
dpush(result.elements.value());
|
||||
}
|
||||
|
||||
void clear_gc_stats()
|
||||
PRIMITIVE(gc_stats)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_gc_stats();
|
||||
}
|
||||
|
||||
void factorvm::clear_gc_stats()
|
||||
{
|
||||
for(cell i = 0; i < max_gen_count; i++)
|
||||
memset(&stats[i],0,sizeof(gc_stats));
|
||||
|
@ -646,14 +648,19 @@ void clear_gc_stats()
|
|||
code_heap_scans = 0;
|
||||
}
|
||||
|
||||
PRIMITIVE(clear_gc_stats)
|
||||
inline void factorvm::vmprim_clear_gc_stats()
|
||||
{
|
||||
clear_gc_stats();
|
||||
}
|
||||
|
||||
PRIMITIVE(clear_gc_stats)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_clear_gc_stats();
|
||||
}
|
||||
|
||||
/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
|
||||
to coalesce equal but distinct quotations and wrappers. */
|
||||
PRIMITIVE(become)
|
||||
inline void factorvm::vmprim_become()
|
||||
{
|
||||
array *new_objects = untag_check<array>(dpop());
|
||||
array *old_objects = untag_check<array>(dpop());
|
||||
|
@ -682,7 +689,12 @@ PRIMITIVE(become)
|
|||
compile_all_words();
|
||||
}
|
||||
|
||||
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
|
||||
PRIMITIVE(become)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_become();
|
||||
}
|
||||
|
||||
void factorvm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
|
||||
{
|
||||
for(cell i = 0; i < gc_roots_size; i++)
|
||||
gc_locals.push_back((cell)&gc_roots_base[i]);
|
||||
|
@ -693,4 +705,10 @@ VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
|
|||
gc_locals.pop_back();
|
||||
}
|
||||
|
||||
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -10,139 +10,16 @@ struct gc_stats {
|
|||
u64 bytes_copied;
|
||||
};
|
||||
|
||||
extern zone *newspace;
|
||||
|
||||
extern bool performing_compaction;
|
||||
extern cell collecting_gen;
|
||||
extern bool collecting_aging_again;
|
||||
|
||||
extern cell last_code_heap_scan;
|
||||
|
||||
void init_data_gc();
|
||||
|
||||
void gc();
|
||||
|
||||
inline static bool collecting_accumulation_gen_p()
|
||||
{
|
||||
return ((data->have_aging_p()
|
||||
&& collecting_gen == data->aging()
|
||||
&& !collecting_aging_again)
|
||||
|| collecting_gen == data->tenured());
|
||||
}
|
||||
|
||||
void copy_handle(cell *handle);
|
||||
|
||||
void garbage_collection(volatile cell gen,
|
||||
bool growing_data_heap_,
|
||||
cell requested_bytes);
|
||||
|
||||
/* We leave this many bytes free at the top of the nursery so that inline
|
||||
allocation (which does not call GC because of possible roots in volatile
|
||||
registers) does not run out of memory */
|
||||
static const cell allot_buffer_zone = 1024;
|
||||
|
||||
inline static object *allot_zone(zone *z, cell a)
|
||||
{
|
||||
cell h = z->here;
|
||||
z->here = h + align8(a);
|
||||
object *obj = (object *)h;
|
||||
allot_barrier(obj);
|
||||
return obj;
|
||||
}
|
||||
|
||||
/*
|
||||
* It is up to the caller to fill in the object's fields in a meaningful
|
||||
* fashion!
|
||||
*/
|
||||
inline static object *allot_object(header header, cell size)
|
||||
{
|
||||
#ifdef GC_DEBUG
|
||||
if(!gc_off)
|
||||
gc();
|
||||
#endif
|
||||
|
||||
object *obj;
|
||||
|
||||
if(nursery.size - allot_buffer_zone > size)
|
||||
{
|
||||
/* If there is insufficient room, collect the nursery */
|
||||
if(nursery.here + allot_buffer_zone + size > nursery.end)
|
||||
garbage_collection(data->nursery(),false,0);
|
||||
|
||||
cell h = nursery.here;
|
||||
nursery.here = h + align8(size);
|
||||
obj = (object *)h;
|
||||
}
|
||||
/* If the object is bigger than the nursery, allocate it in
|
||||
tenured space */
|
||||
else
|
||||
{
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
/* If tenured space does not have enough room, collect */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
gc();
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
/* If it still won't fit, grow the heap */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
garbage_collection(data->tenured(),true,size);
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
obj = allot_zone(tenured,size);
|
||||
|
||||
/* Allows initialization code to store old->new pointers
|
||||
without hitting the write barrier in the common case of
|
||||
a nursery allocation */
|
||||
write_barrier(obj);
|
||||
}
|
||||
|
||||
obj->h = header;
|
||||
return obj;
|
||||
}
|
||||
|
||||
template<typename T> T *allot(cell size)
|
||||
{
|
||||
return (T *)allot_object(header(T::type_number),size);
|
||||
}
|
||||
|
||||
void copy_reachable_objects(cell scan, cell *end);
|
||||
|
||||
PRIMITIVE(gc);
|
||||
PRIMITIVE(gc_stats);
|
||||
void clear_gc_stats();
|
||||
PRIMITIVE(clear_gc_stats);
|
||||
PRIMITIVE(become);
|
||||
|
||||
extern bool growing_data_heap;
|
||||
|
||||
inline static void check_data_pointer(object *pointer)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!growing_data_heap)
|
||||
{
|
||||
assert((cell)pointer >= data->seg->start
|
||||
&& (cell)pointer < data->seg->end);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
inline static void check_tagged_pointer(cell tagged)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!immediate_p(tagged))
|
||||
{
|
||||
object *obj = untag<object>(tagged);
|
||||
check_data_pointer(obj);
|
||||
obj->h.hi_tag();
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
|
||||
struct factorvm;
|
||||
VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factorvm *myvm);
|
||||
|
||||
}
|
||||
|
|
|
@ -1,22 +1,9 @@
|
|||
#include "master.hpp"
|
||||
|
||||
factor::zone nursery;
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
/* Set by the -securegc command line argument */
|
||||
bool secure_gc;
|
||||
|
||||
/* new objects are allocated here */
|
||||
VM_C_API zone nursery;
|
||||
|
||||
/* GC is off during heap walking */
|
||||
bool gc_off;
|
||||
|
||||
data_heap *data;
|
||||
|
||||
cell init_zone(zone *z, cell size, cell start)
|
||||
cell factorvm::init_zone(zone *z, cell size, cell start)
|
||||
{
|
||||
z->size = size;
|
||||
z->start = z->here = start;
|
||||
|
@ -24,7 +11,8 @@ cell init_zone(zone *z, cell size, cell start)
|
|||
return z->end;
|
||||
}
|
||||
|
||||
void init_card_decks()
|
||||
|
||||
void factorvm::init_card_decks()
|
||||
{
|
||||
cell start = align(data->seg->start,deck_size);
|
||||
allot_markers_offset = (cell)data->allot_markers - (start >> card_bits);
|
||||
|
@ -32,10 +20,7 @@ void init_card_decks()
|
|||
decks_offset = (cell)data->decks - (start >> deck_bits);
|
||||
}
|
||||
|
||||
data_heap *alloc_data_heap(cell gens,
|
||||
cell young_size,
|
||||
cell aging_size,
|
||||
cell tenured_size)
|
||||
data_heap *factorvm::alloc_data_heap(cell gens, cell young_size,cell aging_size,cell tenured_size)
|
||||
{
|
||||
young_size = align(young_size,deck_size);
|
||||
aging_size = align(aging_size,deck_size);
|
||||
|
@ -99,7 +84,8 @@ data_heap *alloc_data_heap(cell gens,
|
|||
return data;
|
||||
}
|
||||
|
||||
data_heap *grow_data_heap(data_heap *data, cell requested_bytes)
|
||||
|
||||
data_heap *factorvm::grow_data_heap(data_heap *data, cell requested_bytes)
|
||||
{
|
||||
cell new_tenured_size = (data->tenured_size * 2) + requested_bytes;
|
||||
|
||||
|
@ -109,7 +95,8 @@ data_heap *grow_data_heap(data_heap *data, cell requested_bytes)
|
|||
new_tenured_size);
|
||||
}
|
||||
|
||||
void dealloc_data_heap(data_heap *data)
|
||||
|
||||
void factorvm::dealloc_data_heap(data_heap *data)
|
||||
{
|
||||
dealloc_segment(data->seg);
|
||||
free(data->generations);
|
||||
|
@ -120,7 +107,8 @@ void dealloc_data_heap(data_heap *data)
|
|||
free(data);
|
||||
}
|
||||
|
||||
void clear_cards(cell from, cell to)
|
||||
|
||||
void factorvm::clear_cards(cell from, cell to)
|
||||
{
|
||||
/* NOTE: reverse order due to heap layout. */
|
||||
card *first_card = addr_to_card(data->generations[to].start);
|
||||
|
@ -128,7 +116,8 @@ void clear_cards(cell from, cell to)
|
|||
memset(first_card,0,last_card - first_card);
|
||||
}
|
||||
|
||||
void clear_decks(cell from, cell to)
|
||||
|
||||
void factorvm::clear_decks(cell from, cell to)
|
||||
{
|
||||
/* NOTE: reverse order due to heap layout. */
|
||||
card_deck *first_deck = addr_to_deck(data->generations[to].start);
|
||||
|
@ -136,7 +125,8 @@ void clear_decks(cell from, cell to)
|
|||
memset(first_deck,0,last_deck - first_deck);
|
||||
}
|
||||
|
||||
void clear_allot_markers(cell from, cell to)
|
||||
|
||||
void factorvm::clear_allot_markers(cell from, cell to)
|
||||
{
|
||||
/* NOTE: reverse order due to heap layout. */
|
||||
card *first_card = addr_to_allot_marker((object *)data->generations[to].start);
|
||||
|
@ -144,7 +134,8 @@ void clear_allot_markers(cell from, cell to)
|
|||
memset(first_card,invalid_allot_marker,last_card - first_card);
|
||||
}
|
||||
|
||||
void reset_generation(cell i)
|
||||
|
||||
void factorvm::reset_generation(cell i)
|
||||
{
|
||||
zone *z = (i == data->nursery() ? &nursery : &data->generations[i]);
|
||||
|
||||
|
@ -153,9 +144,10 @@ void reset_generation(cell i)
|
|||
memset((void*)z->start,69,z->size);
|
||||
}
|
||||
|
||||
|
||||
/* After garbage collection, any generations which are now empty need to have
|
||||
their allocation pointers and cards reset. */
|
||||
void reset_generations(cell from, cell to)
|
||||
void factorvm::reset_generations(cell from, cell to)
|
||||
{
|
||||
cell i;
|
||||
for(i = from; i <= to; i++)
|
||||
|
@ -166,7 +158,8 @@ void reset_generations(cell from, cell to)
|
|||
clear_allot_markers(from,to);
|
||||
}
|
||||
|
||||
void set_data_heap(data_heap *data_)
|
||||
|
||||
void factorvm::set_data_heap(data_heap *data_)
|
||||
{
|
||||
data = data_;
|
||||
nursery = data->generations[data->nursery()];
|
||||
|
@ -176,19 +169,17 @@ void set_data_heap(data_heap *data_)
|
|||
clear_allot_markers(data->nursery(),data->tenured());
|
||||
}
|
||||
|
||||
void init_data_heap(cell gens,
|
||||
cell young_size,
|
||||
cell aging_size,
|
||||
cell tenured_size,
|
||||
bool secure_gc_)
|
||||
|
||||
void factorvm::init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_)
|
||||
{
|
||||
set_data_heap(alloc_data_heap(gens,young_size,aging_size,tenured_size));
|
||||
secure_gc = secure_gc_;
|
||||
init_data_gc();
|
||||
}
|
||||
|
||||
|
||||
/* Size of the object pointed to by a tagged pointer */
|
||||
cell object_size(cell tagged)
|
||||
cell factorvm::object_size(cell tagged)
|
||||
{
|
||||
if(immediate_p(tagged))
|
||||
return 0;
|
||||
|
@ -196,14 +187,16 @@ cell object_size(cell tagged)
|
|||
return untagged_object_size(untag<object>(tagged));
|
||||
}
|
||||
|
||||
|
||||
/* Size of the object pointed to by an untagged pointer */
|
||||
cell untagged_object_size(object *pointer)
|
||||
cell factorvm::untagged_object_size(object *pointer)
|
||||
{
|
||||
return align8(unaligned_object_size(pointer));
|
||||
}
|
||||
|
||||
|
||||
/* Size of the data area of an object pointed to by an untagged pointer */
|
||||
cell unaligned_object_size(object *pointer)
|
||||
cell factorvm::unaligned_object_size(object *pointer)
|
||||
{
|
||||
switch(pointer->h.hi_tag())
|
||||
{
|
||||
|
@ -237,15 +230,21 @@ cell unaligned_object_size(object *pointer)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(size)
|
||||
|
||||
inline void factorvm::vmprim_size()
|
||||
{
|
||||
box_unsigned_cell(object_size(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE(size)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_size();
|
||||
}
|
||||
|
||||
/* The number of cells from the start of the object which should be scanned by
|
||||
the GC. Some types have a binary payload at the end (string, word, DLL) which
|
||||
we ignore. */
|
||||
cell binary_payload_start(object *pointer)
|
||||
cell factorvm::binary_payload_start(object *pointer)
|
||||
{
|
||||
switch(pointer->h.hi_tag())
|
||||
{
|
||||
|
@ -279,13 +278,14 @@ cell binary_payload_start(object *pointer)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Push memory usage statistics in data heap */
|
||||
PRIMITIVE(data_room)
|
||||
inline void factorvm::vmprim_data_room()
|
||||
{
|
||||
dpush(tag_fixnum((data->cards_end - data->cards) >> 10));
|
||||
dpush(tag_fixnum((data->decks_end - data->decks) >> 10));
|
||||
|
||||
growable_array a;
|
||||
growable_array a(this);
|
||||
|
||||
cell gen;
|
||||
for(gen = 0; gen < data->gen_count; gen++)
|
||||
|
@ -299,28 +299,36 @@ PRIMITIVE(data_room)
|
|||
dpush(a.elements.value());
|
||||
}
|
||||
|
||||
/* A heap walk allows useful things to be done, like finding all
|
||||
references to an object for debugging purposes. */
|
||||
cell heap_scan_ptr;
|
||||
PRIMITIVE(data_room)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_data_room();
|
||||
}
|
||||
|
||||
/* Disables GC and activates next-object ( -- obj ) primitive */
|
||||
void begin_scan()
|
||||
void factorvm::begin_scan()
|
||||
{
|
||||
heap_scan_ptr = data->generations[data->tenured()].start;
|
||||
gc_off = true;
|
||||
}
|
||||
|
||||
void end_scan()
|
||||
|
||||
void factorvm::end_scan()
|
||||
{
|
||||
gc_off = false;
|
||||
}
|
||||
|
||||
PRIMITIVE(begin_scan)
|
||||
|
||||
inline void factorvm::vmprim_begin_scan()
|
||||
{
|
||||
begin_scan();
|
||||
}
|
||||
|
||||
cell next_object()
|
||||
PRIMITIVE(begin_scan)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_begin_scan();
|
||||
}
|
||||
|
||||
cell factorvm::next_object()
|
||||
{
|
||||
if(!gc_off)
|
||||
general_error(ERROR_HEAP_SCAN,F,F,NULL);
|
||||
|
@ -333,19 +341,30 @@ cell next_object()
|
|||
return tag_dynamic(obj);
|
||||
}
|
||||
|
||||
|
||||
/* Push object at heap scan cursor and advance; pushes f when done */
|
||||
PRIMITIVE(next_object)
|
||||
inline void factorvm::vmprim_next_object()
|
||||
{
|
||||
dpush(next_object());
|
||||
}
|
||||
|
||||
PRIMITIVE(next_object)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_next_object();
|
||||
}
|
||||
|
||||
/* Re-enables GC */
|
||||
PRIMITIVE(end_scan)
|
||||
inline void factorvm::vmprim_end_scan()
|
||||
{
|
||||
gc_off = false;
|
||||
}
|
||||
|
||||
template<typename T> void each_object(T &functor)
|
||||
PRIMITIVE(end_scan)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_end_scan();
|
||||
}
|
||||
|
||||
template<typename TYPE> void factorvm::each_object(TYPE &functor)
|
||||
{
|
||||
begin_scan();
|
||||
cell obj;
|
||||
|
@ -354,6 +373,7 @@ template<typename T> void each_object(T &functor)
|
|||
end_scan();
|
||||
}
|
||||
|
||||
|
||||
namespace
|
||||
{
|
||||
|
||||
|
@ -365,20 +385,21 @@ struct word_counter {
|
|||
|
||||
struct word_accumulator {
|
||||
growable_array words;
|
||||
word_accumulator(int count) : words(count) {}
|
||||
word_accumulator(int count,factorvm *vm) : words(vm,count) {}
|
||||
void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) words.add(obj.value()); }
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
cell find_all_words()
|
||||
cell factorvm::find_all_words()
|
||||
{
|
||||
word_counter counter;
|
||||
each_object(counter);
|
||||
word_accumulator accum(counter.count);
|
||||
word_accumulator accum(counter.count,this);
|
||||
each_object(accum);
|
||||
accum.words.trim();
|
||||
return accum.words.elements.value();
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
|
|
@ -1,8 +1,6 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
/* Set by the -securegc command line argument */
|
||||
extern bool secure_gc;
|
||||
|
||||
/* generational copying GC divides memory into zones */
|
||||
struct zone {
|
||||
|
@ -47,7 +45,6 @@ struct data_heap {
|
|||
bool have_aging_p() { return gen_count > 2; }
|
||||
};
|
||||
|
||||
extern data_heap *data;
|
||||
|
||||
static const cell max_gen_count = 3;
|
||||
|
||||
|
@ -56,42 +53,11 @@ inline static bool in_zone(zone *z, object *pointer)
|
|||
return (cell)pointer >= z->start && (cell)pointer < z->end;
|
||||
}
|
||||
|
||||
cell init_zone(zone *z, cell size, cell base);
|
||||
|
||||
void init_card_decks();
|
||||
|
||||
data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
|
||||
|
||||
void dealloc_data_heap(data_heap *data);
|
||||
|
||||
void clear_cards(cell from, cell to);
|
||||
void clear_decks(cell from, cell to);
|
||||
void clear_allot_markers(cell from, cell to);
|
||||
void reset_generation(cell i);
|
||||
void reset_generations(cell from, cell to);
|
||||
|
||||
void set_data_heap(data_heap *data_heap_);
|
||||
|
||||
void init_data_heap(cell gens,
|
||||
cell young_size,
|
||||
cell aging_size,
|
||||
cell tenured_size,
|
||||
bool secure_gc_);
|
||||
|
||||
/* set up guard pages to check for under/overflow.
|
||||
size must be a multiple of the page size */
|
||||
segment *alloc_segment(cell size);
|
||||
segment *alloc_segment(cell size); // defined in OS-*.cpp files PD
|
||||
void dealloc_segment(segment *block);
|
||||
|
||||
cell untagged_object_size(object *pointer);
|
||||
cell unaligned_object_size(object *pointer);
|
||||
cell binary_payload_start(object *pointer);
|
||||
cell object_size(cell tagged);
|
||||
|
||||
void begin_scan();
|
||||
void end_scan();
|
||||
cell next_object();
|
||||
|
||||
PRIMITIVE(data_room);
|
||||
PRIMITIVE(size);
|
||||
|
||||
|
@ -99,30 +65,4 @@ PRIMITIVE(begin_scan);
|
|||
PRIMITIVE(next_object);
|
||||
PRIMITIVE(end_scan);
|
||||
|
||||
/* GC is off during heap walking */
|
||||
extern bool gc_off;
|
||||
|
||||
cell find_all_words();
|
||||
|
||||
/* Every object has a regular representation in the runtime, which makes GC
|
||||
much simpler. Every slot of the object until binary_payload_start is a pointer
|
||||
to some other object. */
|
||||
inline static void do_slots(cell obj, void (* iter)(cell *))
|
||||
{
|
||||
cell scan = obj;
|
||||
cell payload_start = binary_payload_start((object *)obj);
|
||||
cell end = obj + payload_start;
|
||||
|
||||
scan += sizeof(cell);
|
||||
|
||||
while(scan < end)
|
||||
{
|
||||
iter((cell *)scan);
|
||||
scan += sizeof(cell);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
/* new objects are allocated here */
|
||||
VM_C_API factor::zone nursery;
|
||||
|
|
|
@ -3,17 +3,16 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
static bool fep_disabled;
|
||||
static bool full_output;
|
||||
|
||||
void print_chars(string* str)
|
||||
void factorvm::print_chars(string* str)
|
||||
{
|
||||
cell i;
|
||||
for(i = 0; i < string_capacity(str); i++)
|
||||
putchar(string_nth(str,i));
|
||||
}
|
||||
|
||||
void print_word(word* word, cell nesting)
|
||||
|
||||
void factorvm::print_word(word* word, cell nesting)
|
||||
{
|
||||
if(tagged<object>(word->vocabulary).type_p(STRING_TYPE))
|
||||
{
|
||||
|
@ -31,14 +30,16 @@ void print_word(word* word, cell nesting)
|
|||
}
|
||||
}
|
||||
|
||||
void print_factor_string(string* str)
|
||||
|
||||
void factorvm::print_factor_string(string* str)
|
||||
{
|
||||
putchar('"');
|
||||
print_chars(str);
|
||||
putchar('"');
|
||||
}
|
||||
|
||||
void print_array(array* array, cell nesting)
|
||||
|
||||
void factorvm::print_array(array* array, cell nesting)
|
||||
{
|
||||
cell length = array_capacity(array);
|
||||
cell i;
|
||||
|
@ -62,7 +63,8 @@ void print_array(array* array, cell nesting)
|
|||
print_string("...");
|
||||
}
|
||||
|
||||
void print_tuple(tuple *tuple, cell nesting)
|
||||
|
||||
void factorvm::print_tuple(tuple *tuple, cell nesting)
|
||||
{
|
||||
tuple_layout *layout = untag<tuple_layout>(tuple->layout);
|
||||
cell length = to_fixnum(layout->size);
|
||||
|
@ -91,7 +93,8 @@ void print_tuple(tuple *tuple, cell nesting)
|
|||
print_string("...");
|
||||
}
|
||||
|
||||
void print_nested_obj(cell obj, fixnum nesting)
|
||||
|
||||
void factorvm::print_nested_obj(cell obj, fixnum nesting)
|
||||
{
|
||||
if(nesting <= 0 && !full_output)
|
||||
{
|
||||
|
@ -141,12 +144,14 @@ void print_nested_obj(cell obj, fixnum nesting)
|
|||
}
|
||||
}
|
||||
|
||||
void print_obj(cell obj)
|
||||
|
||||
void factorvm::print_obj(cell obj)
|
||||
{
|
||||
print_nested_obj(obj,10);
|
||||
}
|
||||
|
||||
void print_objects(cell *start, cell *end)
|
||||
|
||||
void factorvm::print_objects(cell *start, cell *end)
|
||||
{
|
||||
for(; start <= end; start++)
|
||||
{
|
||||
|
@ -155,19 +160,22 @@ void print_objects(cell *start, cell *end)
|
|||
}
|
||||
}
|
||||
|
||||
void print_datastack()
|
||||
|
||||
void factorvm::print_datastack()
|
||||
{
|
||||
print_string("==== DATA STACK:\n");
|
||||
print_objects((cell *)ds_bot,(cell *)ds);
|
||||
}
|
||||
|
||||
void print_retainstack()
|
||||
|
||||
void factorvm::print_retainstack()
|
||||
{
|
||||
print_string("==== RETAIN STACK:\n");
|
||||
print_objects((cell *)rs_bot,(cell *)rs);
|
||||
}
|
||||
|
||||
void print_stack_frame(stack_frame *frame)
|
||||
|
||||
void factorvm::print_stack_frame(stack_frame *frame)
|
||||
{
|
||||
print_obj(frame_executing(frame));
|
||||
print_string("\n");
|
||||
|
@ -184,15 +192,21 @@ void print_stack_frame(stack_frame *frame)
|
|||
print_string("\n");
|
||||
}
|
||||
|
||||
void print_callstack()
|
||||
void print_stack_frame(stack_frame *frame, factorvm *myvm)
|
||||
{
|
||||
return myvm->print_stack_frame(frame);
|
||||
}
|
||||
|
||||
void factorvm::print_callstack()
|
||||
{
|
||||
print_string("==== CALL STACK:\n");
|
||||
cell bottom = (cell)stack_chain->callstack_bottom;
|
||||
cell top = (cell)stack_chain->callstack_top;
|
||||
iterate_callstack(top,bottom,print_stack_frame);
|
||||
iterate_callstack(top,bottom,factor::print_stack_frame);
|
||||
}
|
||||
|
||||
void dump_cell(cell x)
|
||||
|
||||
void factorvm::dump_cell(cell x)
|
||||
{
|
||||
print_cell_hex_pad(x); print_string(": ");
|
||||
x = *(cell *)x;
|
||||
|
@ -200,7 +214,8 @@ void dump_cell(cell x)
|
|||
nl();
|
||||
}
|
||||
|
||||
void dump_memory(cell from, cell to)
|
||||
|
||||
void factorvm::dump_memory(cell from, cell to)
|
||||
{
|
||||
from = UNTAG(from);
|
||||
|
||||
|
@ -208,14 +223,16 @@ void dump_memory(cell from, cell to)
|
|||
dump_cell(from);
|
||||
}
|
||||
|
||||
void dump_zone(zone *z)
|
||||
|
||||
void factorvm::dump_zone(zone *z)
|
||||
{
|
||||
print_string("Start="); print_cell(z->start);
|
||||
print_string(", size="); print_cell(z->size);
|
||||
print_string(", here="); print_cell(z->here - z->start); nl();
|
||||
}
|
||||
|
||||
void dump_generations()
|
||||
|
||||
void factorvm::dump_generations()
|
||||
{
|
||||
cell i;
|
||||
|
||||
|
@ -241,7 +258,8 @@ void dump_generations()
|
|||
nl();
|
||||
}
|
||||
|
||||
void dump_objects(cell type)
|
||||
|
||||
void factorvm::dump_objects(cell type)
|
||||
{
|
||||
gc();
|
||||
begin_scan();
|
||||
|
@ -261,10 +279,9 @@ void dump_objects(cell type)
|
|||
end_scan();
|
||||
}
|
||||
|
||||
cell look_for;
|
||||
cell obj;
|
||||
|
||||
void find_data_references_step(cell *scan)
|
||||
|
||||
void factorvm::find_data_references_step(cell *scan)
|
||||
{
|
||||
if(look_for == *scan)
|
||||
{
|
||||
|
@ -275,20 +292,26 @@ void find_data_references_step(cell *scan)
|
|||
}
|
||||
}
|
||||
|
||||
void find_data_references(cell look_for_)
|
||||
void find_data_references_step(cell *scan,factorvm *myvm)
|
||||
{
|
||||
return myvm->find_data_references_step(scan);
|
||||
}
|
||||
|
||||
void factorvm::find_data_references(cell look_for_)
|
||||
{
|
||||
look_for = look_for_;
|
||||
|
||||
begin_scan();
|
||||
|
||||
while((obj = next_object()) != F)
|
||||
do_slots(UNTAG(obj),find_data_references_step);
|
||||
do_slots(UNTAG(obj),factor::find_data_references_step);
|
||||
|
||||
end_scan();
|
||||
}
|
||||
|
||||
|
||||
/* Dump all code blocks for debugging */
|
||||
void dump_code_heap()
|
||||
void factorvm::dump_code_heap()
|
||||
{
|
||||
cell reloc_size = 0, literal_size = 0;
|
||||
|
||||
|
@ -328,7 +351,8 @@ void dump_code_heap()
|
|||
print_cell(literal_size); print_string(" bytes of literal data\n");
|
||||
}
|
||||
|
||||
void factorbug()
|
||||
|
||||
void factorvm::factorbug()
|
||||
{
|
||||
if(fep_disabled)
|
||||
{
|
||||
|
@ -472,11 +496,17 @@ void factorbug()
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(die)
|
||||
|
||||
inline void factorvm::vmprim_die()
|
||||
{
|
||||
print_string("The die word was called by the library. Unless you called it yourself,\n");
|
||||
print_string("you have triggered a bug in Factor. Please report.\n");
|
||||
factorbug();
|
||||
}
|
||||
|
||||
PRIMITIVE(die)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_die();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,11 +1,6 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
void print_obj(cell obj);
|
||||
void print_nested_obj(cell obj, fixnum nesting);
|
||||
void dump_generations();
|
||||
void factorbug();
|
||||
void dump_zone(zone *z);
|
||||
|
||||
PRIMITIVE(die);
|
||||
|
||||
|
|
|
@ -3,10 +3,7 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
cell megamorphic_cache_hits;
|
||||
cell megamorphic_cache_misses;
|
||||
|
||||
static cell search_lookup_alist(cell table, cell klass)
|
||||
cell factorvm::search_lookup_alist(cell table, cell klass)
|
||||
{
|
||||
array *elements = untag<array>(table);
|
||||
fixnum index = array_capacity(elements) - 2;
|
||||
|
@ -21,7 +18,7 @@ static cell search_lookup_alist(cell table, cell klass)
|
|||
return F;
|
||||
}
|
||||
|
||||
static cell search_lookup_hash(cell table, cell klass, cell hashcode)
|
||||
cell factorvm::search_lookup_hash(cell table, cell klass, cell hashcode)
|
||||
{
|
||||
array *buckets = untag<array>(table);
|
||||
cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
|
||||
|
@ -31,19 +28,19 @@ static cell search_lookup_hash(cell table, cell klass, cell hashcode)
|
|||
return search_lookup_alist(bucket,klass);
|
||||
}
|
||||
|
||||
static cell nth_superclass(tuple_layout *layout, fixnum echelon)
|
||||
cell factorvm::nth_superclass(tuple_layout *layout, fixnum echelon)
|
||||
{
|
||||
cell *ptr = (cell *)(layout + 1);
|
||||
return ptr[echelon * 2];
|
||||
}
|
||||
|
||||
static cell nth_hashcode(tuple_layout *layout, fixnum echelon)
|
||||
cell factorvm::nth_hashcode(tuple_layout *layout, fixnum echelon)
|
||||
{
|
||||
cell *ptr = (cell *)(layout + 1);
|
||||
return ptr[echelon * 2 + 1];
|
||||
}
|
||||
|
||||
static cell lookup_tuple_method(cell obj, cell methods)
|
||||
cell factorvm::lookup_tuple_method(cell obj, cell methods)
|
||||
{
|
||||
tuple_layout *layout = untag<tuple_layout>(untag<tuple>(obj)->layout);
|
||||
|
||||
|
@ -75,7 +72,7 @@ static cell lookup_tuple_method(cell obj, cell methods)
|
|||
return F;
|
||||
}
|
||||
|
||||
static cell lookup_hi_tag_method(cell obj, cell methods)
|
||||
cell factorvm::lookup_hi_tag_method(cell obj, cell methods)
|
||||
{
|
||||
array *hi_tag_methods = untag<array>(methods);
|
||||
cell tag = untag<object>(obj)->h.hi_tag() - HEADER_TYPE;
|
||||
|
@ -85,7 +82,7 @@ static cell lookup_hi_tag_method(cell obj, cell methods)
|
|||
return array_nth(hi_tag_methods,tag);
|
||||
}
|
||||
|
||||
static cell lookup_hairy_method(cell obj, cell methods)
|
||||
cell factorvm::lookup_hairy_method(cell obj, cell methods)
|
||||
{
|
||||
cell method = array_nth(untag<array>(methods),TAG(obj));
|
||||
if(tagged<object>(method).type_p(WORD_TYPE))
|
||||
|
@ -107,7 +104,7 @@ static cell lookup_hairy_method(cell obj, cell methods)
|
|||
}
|
||||
}
|
||||
|
||||
cell lookup_method(cell obj, cell methods)
|
||||
cell factorvm::lookup_method(cell obj, cell methods)
|
||||
{
|
||||
cell tag = TAG(obj);
|
||||
if(tag == TUPLE_TYPE || tag == OBJECT_TYPE)
|
||||
|
@ -116,14 +113,19 @@ cell lookup_method(cell obj, cell methods)
|
|||
return array_nth(untag<array>(methods),TAG(obj));
|
||||
}
|
||||
|
||||
PRIMITIVE(lookup_method)
|
||||
inline void factorvm::vmprim_lookup_method()
|
||||
{
|
||||
cell methods = dpop();
|
||||
cell obj = dpop();
|
||||
dpush(lookup_method(obj,methods));
|
||||
}
|
||||
|
||||
cell object_class(cell obj)
|
||||
PRIMITIVE(lookup_method)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_lookup_method();
|
||||
}
|
||||
|
||||
cell factorvm::object_class(cell obj)
|
||||
{
|
||||
switch(TAG(obj))
|
||||
{
|
||||
|
@ -136,13 +138,13 @@ cell object_class(cell obj)
|
|||
}
|
||||
}
|
||||
|
||||
static cell method_cache_hashcode(cell klass, array *array)
|
||||
cell factorvm::method_cache_hashcode(cell klass, array *array)
|
||||
{
|
||||
cell capacity = (array_capacity(array) >> 1) - 1;
|
||||
return ((klass >> TAG_BITS) & capacity) << 1;
|
||||
}
|
||||
|
||||
static void update_method_cache(cell cache, cell klass, cell method)
|
||||
void factorvm::update_method_cache(cell cache, cell klass, cell method)
|
||||
{
|
||||
array *cache_elements = untag<array>(cache);
|
||||
cell hashcode = method_cache_hashcode(klass,cache_elements);
|
||||
|
@ -150,7 +152,7 @@ static void update_method_cache(cell cache, cell klass, cell method)
|
|||
set_array_nth(cache_elements,hashcode + 1,method);
|
||||
}
|
||||
|
||||
PRIMITIVE(mega_cache_miss)
|
||||
inline void factorvm::vmprim_mega_cache_miss()
|
||||
{
|
||||
megamorphic_cache_misses++;
|
||||
|
||||
|
@ -167,44 +169,59 @@ PRIMITIVE(mega_cache_miss)
|
|||
dpush(method);
|
||||
}
|
||||
|
||||
PRIMITIVE(reset_dispatch_stats)
|
||||
PRIMITIVE(mega_cache_miss)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_mega_cache_miss();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_reset_dispatch_stats()
|
||||
{
|
||||
megamorphic_cache_hits = megamorphic_cache_misses = 0;
|
||||
}
|
||||
|
||||
PRIMITIVE(dispatch_stats)
|
||||
PRIMITIVE(reset_dispatch_stats)
|
||||
{
|
||||
growable_array stats;
|
||||
PRIMITIVE_GETVM()->vmprim_reset_dispatch_stats();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_dispatch_stats()
|
||||
{
|
||||
growable_array stats(this);
|
||||
stats.add(allot_cell(megamorphic_cache_hits));
|
||||
stats.add(allot_cell(megamorphic_cache_misses));
|
||||
stats.trim();
|
||||
dpush(stats.elements.value());
|
||||
}
|
||||
|
||||
PRIMITIVE(dispatch_stats)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_dispatch_stats();
|
||||
}
|
||||
|
||||
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)
|
||||
{
|
||||
gc_root<array> methods(methods_);
|
||||
gc_root<array> cache(cache_);
|
||||
gc_root<array> methods(methods_,myvm);
|
||||
gc_root<array> cache(cache_,myvm);
|
||||
|
||||
/* Generate machine code to determine the object's class. */
|
||||
emit_class_lookup(index,PIC_HI_TAG_TUPLE);
|
||||
|
||||
/* Do a cache lookup. */
|
||||
emit_with(userenv[MEGA_LOOKUP],cache.value());
|
||||
emit_with(myvm->userenv[MEGA_LOOKUP],cache.value());
|
||||
|
||||
/* If we end up here, the cache missed. */
|
||||
emit(userenv[JIT_PROLOG]);
|
||||
emit(myvm->userenv[JIT_PROLOG]);
|
||||
|
||||
/* Push index, method table and cache on the stack. */
|
||||
push(methods.value());
|
||||
push(tag_fixnum(index));
|
||||
push(cache.value());
|
||||
word_call(userenv[MEGA_MISS_WORD]);
|
||||
word_call(myvm->userenv[MEGA_MISS_WORD]);
|
||||
|
||||
/* Now the new method has been stored into the cache, and its on
|
||||
the stack. */
|
||||
emit(userenv[JIT_EPILOG]);
|
||||
emit(userenv[JIT_EXECUTE_JUMP]);
|
||||
emit(myvm->userenv[JIT_EPILOG]);
|
||||
emit(myvm->userenv[JIT_EXECUTE_JUMP]);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,21 +1,9 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
extern cell megamorphic_cache_hits;
|
||||
extern cell megamorphic_cache_misses;
|
||||
|
||||
cell lookup_method(cell object, cell methods);
|
||||
PRIMITIVE(lookup_method);
|
||||
|
||||
cell object_class(cell object);
|
||||
|
||||
PRIMITIVE(mega_cache_miss);
|
||||
|
||||
PRIMITIVE(reset_dispatch_stats);
|
||||
PRIMITIVE(dispatch_stats);
|
||||
|
||||
void jit_emit_class_lookup(jit *jit, fixnum index, cell type);
|
||||
|
||||
void jit_emit_mega_cache_lookup(jit *jit, cell methods, fixnum index, cell cache);
|
||||
|
||||
}
|
||||
|
|
|
@ -3,14 +3,7 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
/* Global variables used to pass fault handler state from signal handler to
|
||||
user-space */
|
||||
cell signal_number;
|
||||
cell signal_fault_addr;
|
||||
unsigned int signal_fpu_status;
|
||||
stack_frame *signal_callstack_top;
|
||||
|
||||
void out_of_memory()
|
||||
void factorvm::out_of_memory()
|
||||
{
|
||||
print_string("Out of memory\n\n");
|
||||
dump_generations();
|
||||
|
@ -24,7 +17,7 @@ void fatal_error(const char* msg, cell tagged)
|
|||
exit(1);
|
||||
}
|
||||
|
||||
void critical_error(const char* msg, cell tagged)
|
||||
void factorvm::critical_error(const char* msg, cell tagged)
|
||||
{
|
||||
print_string("You have triggered a bug in Factor. Please report.\n");
|
||||
print_string("critical_error: "); print_string(msg);
|
||||
|
@ -32,7 +25,7 @@ void critical_error(const char* msg, cell tagged)
|
|||
factorbug();
|
||||
}
|
||||
|
||||
void throw_error(cell error, stack_frame *callstack_top)
|
||||
void factorvm::throw_error(cell error, stack_frame *callstack_top)
|
||||
{
|
||||
/* If the error handler is set, we rewind any C stack frames and
|
||||
pass the error to user-space. */
|
||||
|
@ -63,7 +56,7 @@ void throw_error(cell error, stack_frame *callstack_top)
|
|||
else
|
||||
callstack_top = stack_chain->callstack_top;
|
||||
|
||||
throw_impl(userenv[BREAK_ENV],callstack_top);
|
||||
throw_impl(userenv[BREAK_ENV],callstack_top,this);
|
||||
}
|
||||
/* Error was thrown in early startup before error handler is set, just
|
||||
crash. */
|
||||
|
@ -77,26 +70,27 @@ void throw_error(cell error, stack_frame *callstack_top)
|
|||
}
|
||||
}
|
||||
|
||||
void general_error(vm_error_type error, cell arg1, cell arg2,
|
||||
stack_frame *callstack_top)
|
||||
void factorvm::general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top)
|
||||
{
|
||||
throw_error(allot_array_4(userenv[ERROR_ENV],
|
||||
tag_fixnum(error),arg1,arg2),callstack_top);
|
||||
}
|
||||
|
||||
void type_error(cell type, cell tagged)
|
||||
|
||||
void factorvm::type_error(cell type, cell tagged)
|
||||
{
|
||||
general_error(ERROR_TYPE,tag_fixnum(type),tagged,NULL);
|
||||
}
|
||||
|
||||
void not_implemented_error()
|
||||
void factorvm::not_implemented_error()
|
||||
{
|
||||
general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL);
|
||||
}
|
||||
|
||||
|
||||
/* Test if 'fault' is in the guard page at the top or bottom (depending on
|
||||
offset being 0 or -1) of area+area_size */
|
||||
bool in_page(cell fault, cell area, cell area_size, int offset)
|
||||
bool factorvm::in_page(cell fault, cell area, cell area_size, int offset)
|
||||
{
|
||||
int pagesize = getpagesize();
|
||||
area += area_size;
|
||||
|
@ -105,7 +99,7 @@ bool in_page(cell fault, cell area, cell area_size, int offset)
|
|||
return fault >= area && fault <= area + pagesize;
|
||||
}
|
||||
|
||||
void memory_protection_error(cell addr, stack_frame *native_stack)
|
||||
void factorvm::memory_protection_error(cell addr, stack_frame *native_stack)
|
||||
{
|
||||
if(in_page(addr, ds_bot, 0, -1))
|
||||
general_error(ERROR_DS_UNDERFLOW,F,F,native_stack);
|
||||
|
@ -121,45 +115,70 @@ void memory_protection_error(cell addr, stack_frame *native_stack)
|
|||
general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack);
|
||||
}
|
||||
|
||||
void signal_error(int signal, stack_frame *native_stack)
|
||||
void factorvm::signal_error(int signal, stack_frame *native_stack)
|
||||
{
|
||||
general_error(ERROR_SIGNAL,tag_fixnum(signal),F,native_stack);
|
||||
}
|
||||
|
||||
void divide_by_zero_error()
|
||||
void factorvm::divide_by_zero_error()
|
||||
{
|
||||
general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL);
|
||||
}
|
||||
|
||||
void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top)
|
||||
void factorvm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top)
|
||||
{
|
||||
general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),F,signal_callstack_top);
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_call_clear()
|
||||
{
|
||||
throw_impl(dpop(),stack_chain->callstack_bottom,this);
|
||||
}
|
||||
|
||||
PRIMITIVE(call_clear)
|
||||
{
|
||||
throw_impl(dpop(),stack_chain->callstack_bottom);
|
||||
PRIMITIVE_GETVM()->vmprim_call_clear();
|
||||
}
|
||||
|
||||
/* For testing purposes */
|
||||
PRIMITIVE(unimplemented)
|
||||
inline void factorvm::vmprim_unimplemented()
|
||||
{
|
||||
not_implemented_error();
|
||||
}
|
||||
|
||||
void memory_signal_handler_impl()
|
||||
PRIMITIVE(unimplemented)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_unimplemented();
|
||||
}
|
||||
|
||||
void factorvm::memory_signal_handler_impl()
|
||||
{
|
||||
memory_protection_error(signal_fault_addr,signal_callstack_top);
|
||||
}
|
||||
|
||||
void misc_signal_handler_impl()
|
||||
void memory_signal_handler_impl()
|
||||
{
|
||||
SIGNAL_VM_PTR()->memory_signal_handler_impl();
|
||||
}
|
||||
|
||||
void factorvm::misc_signal_handler_impl()
|
||||
{
|
||||
signal_error(signal_number,signal_callstack_top);
|
||||
}
|
||||
|
||||
void fp_signal_handler_impl()
|
||||
void misc_signal_handler_impl()
|
||||
{
|
||||
SIGNAL_VM_PTR()->misc_signal_handler_impl();
|
||||
}
|
||||
|
||||
void factorvm::fp_signal_handler_impl()
|
||||
{
|
||||
fp_trap_error(signal_fpu_status,signal_callstack_top);
|
||||
}
|
||||
|
||||
void fp_signal_handler_impl()
|
||||
{
|
||||
SIGNAL_VM_PTR()->fp_signal_handler_impl();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -23,31 +23,11 @@ enum vm_error_type
|
|||
ERROR_FP_TRAP,
|
||||
};
|
||||
|
||||
void out_of_memory();
|
||||
void fatal_error(const char* msg, cell tagged);
|
||||
void critical_error(const char* msg, cell tagged);
|
||||
|
||||
PRIMITIVE(die);
|
||||
|
||||
void throw_error(cell error, stack_frame *native_stack);
|
||||
void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
|
||||
void divide_by_zero_error();
|
||||
void memory_protection_error(cell addr, stack_frame *native_stack);
|
||||
void signal_error(int signal, stack_frame *native_stack);
|
||||
void type_error(cell type, cell tagged);
|
||||
void not_implemented_error();
|
||||
void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top);
|
||||
|
||||
PRIMITIVE(call_clear);
|
||||
PRIMITIVE(unimplemented);
|
||||
|
||||
/* Global variables used to pass fault handler state from signal handler to
|
||||
user-space */
|
||||
extern cell signal_number;
|
||||
extern cell signal_fault_addr;
|
||||
extern unsigned int signal_fpu_status;
|
||||
extern stack_frame *signal_callstack_top;
|
||||
|
||||
void fatal_error(const char* msg, cell tagged);
|
||||
void memory_signal_handler_impl();
|
||||
void fp_signal_handler_impl();
|
||||
void misc_signal_handler_impl();
|
||||
|
|
|
@ -3,7 +3,14 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
VM_C_API void default_parameters(vm_parameters *p)
|
||||
factorvm *vm;
|
||||
|
||||
void init_globals()
|
||||
{
|
||||
init_platform_globals();
|
||||
}
|
||||
|
||||
void factorvm::default_parameters(vm_parameters *p)
|
||||
{
|
||||
p->image_path = NULL;
|
||||
|
||||
|
@ -37,13 +44,17 @@ VM_C_API void default_parameters(vm_parameters *p)
|
|||
#ifdef WINDOWS
|
||||
p->console = false;
|
||||
#else
|
||||
p->console = true;
|
||||
if (this == vm)
|
||||
p->console = true;
|
||||
else
|
||||
p->console = false;
|
||||
|
||||
#endif
|
||||
|
||||
p->stack_traces = true;
|
||||
}
|
||||
|
||||
static bool factor_arg(const vm_char* str, const vm_char* arg, cell* value)
|
||||
bool factorvm::factor_arg(const vm_char* str, const vm_char* arg, cell* value)
|
||||
{
|
||||
int val;
|
||||
if(SSCANF(str,arg,&val) > 0)
|
||||
|
@ -55,7 +66,7 @@ static bool factor_arg(const vm_char* str, const vm_char* arg, cell* value)
|
|||
return false;
|
||||
}
|
||||
|
||||
VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
|
||||
void factorvm::init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
|
||||
{
|
||||
default_parameters(p);
|
||||
p->executable_path = argv[0];
|
||||
|
@ -81,7 +92,7 @@ VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **ar
|
|||
}
|
||||
|
||||
/* Do some initialization that we do once only */
|
||||
static void do_stage1_init()
|
||||
void factorvm::do_stage1_init()
|
||||
{
|
||||
print_string("*** Stage 2 early init... ");
|
||||
fflush(stdout);
|
||||
|
@ -93,7 +104,7 @@ static void do_stage1_init()
|
|||
fflush(stdout);
|
||||
}
|
||||
|
||||
VM_C_API void init_factor(vm_parameters *p)
|
||||
void factorvm::init_factor(vm_parameters *p)
|
||||
{
|
||||
/* Kilobytes */
|
||||
p->ds_size = align_page(p->ds_size << 10);
|
||||
|
@ -150,19 +161,20 @@ VM_C_API void init_factor(vm_parameters *p)
|
|||
}
|
||||
|
||||
/* May allocate memory */
|
||||
VM_C_API void pass_args_to_factor(int argc, vm_char **argv)
|
||||
void factorvm::pass_args_to_factor(int argc, vm_char **argv)
|
||||
{
|
||||
growable_array args;
|
||||
growable_array args(this);
|
||||
int i;
|
||||
|
||||
for(i = 1; i < argc; i++)
|
||||
for(i = 1; i < argc; i++){
|
||||
args.add(allot_alien(F,(cell)argv[i]));
|
||||
}
|
||||
|
||||
args.trim();
|
||||
userenv[ARGS_ENV] = args.elements.value();
|
||||
}
|
||||
|
||||
static void start_factor(vm_parameters *p)
|
||||
void factorvm::start_factor(vm_parameters *p)
|
||||
{
|
||||
if(p->fep) factorbug();
|
||||
|
||||
|
@ -171,13 +183,31 @@ static void start_factor(vm_parameters *p)
|
|||
unnest_stacks();
|
||||
}
|
||||
|
||||
VM_C_API void start_embedded_factor(vm_parameters *p)
|
||||
|
||||
char *factorvm::factor_eval_string(char *string)
|
||||
{
|
||||
userenv[EMBEDDED_ENV] = T;
|
||||
start_factor(p);
|
||||
char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
|
||||
return callback(string);
|
||||
}
|
||||
|
||||
VM_C_API void start_standalone_factor(int argc, vm_char **argv)
|
||||
void factorvm::factor_eval_free(char *result)
|
||||
{
|
||||
free(result);
|
||||
}
|
||||
|
||||
void factorvm::factor_yield()
|
||||
{
|
||||
void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
|
||||
callback();
|
||||
}
|
||||
|
||||
void factorvm::factor_sleep(long us)
|
||||
{
|
||||
void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]);
|
||||
callback(us);
|
||||
}
|
||||
|
||||
void factorvm::start_standalone_factor(int argc, vm_char **argv)
|
||||
{
|
||||
vm_parameters p;
|
||||
default_parameters(&p);
|
||||
|
@ -187,27 +217,34 @@ VM_C_API void start_standalone_factor(int argc, vm_char **argv)
|
|||
start_factor(&p);
|
||||
}
|
||||
|
||||
VM_C_API char *factor_eval_string(char *string)
|
||||
struct startargs {
|
||||
int argc;
|
||||
vm_char **argv;
|
||||
};
|
||||
|
||||
void* start_standalone_factor_thread(void *arg)
|
||||
{
|
||||
char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
|
||||
return callback(string);
|
||||
factorvm *newvm = new factorvm;
|
||||
register_vm_with_thread(newvm);
|
||||
startargs *args = (startargs*) arg;
|
||||
newvm->start_standalone_factor(args->argc, args->argv);
|
||||
return 0;
|
||||
}
|
||||
|
||||
VM_C_API void factor_eval_free(char *result)
|
||||
|
||||
VM_C_API void start_standalone_factor(int argc, vm_char **argv)
|
||||
{
|
||||
free(result);
|
||||
factorvm *newvm = new factorvm;
|
||||
vm = newvm;
|
||||
register_vm_with_thread(newvm);
|
||||
return newvm->start_standalone_factor(argc,argv);
|
||||
}
|
||||
|
||||
VM_C_API void factor_yield()
|
||||
VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv)
|
||||
{
|
||||
void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
|
||||
callback();
|
||||
}
|
||||
|
||||
VM_C_API void factor_sleep(long us)
|
||||
{
|
||||
void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]);
|
||||
callback(us);
|
||||
startargs *args = new startargs; // leaks startargs structure
|
||||
args->argc = argc; args->argv = argv;
|
||||
return start_thread(start_standalone_factor_thread,args);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,16 +1,8 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
VM_C_API void default_parameters(vm_parameters *p);
|
||||
VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv);
|
||||
VM_C_API void init_factor(vm_parameters *p);
|
||||
VM_C_API void pass_args_to_factor(int argc, vm_char **argv);
|
||||
VM_C_API void start_embedded_factor(vm_parameters *p);
|
||||
VM_C_API void init_globals();
|
||||
|
||||
VM_C_API void start_standalone_factor(int argc, vm_char **argv);
|
||||
|
||||
VM_C_API char *factor_eval_string(char *string);
|
||||
VM_C_API void factor_eval_free(char *result);
|
||||
VM_C_API void factor_yield();
|
||||
VM_C_API void factor_sleep(long ms);
|
||||
|
||||
VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv);
|
||||
}
|
||||
|
|
|
@ -19,41 +19,4 @@ template <typename T> cell array_size(T *array)
|
|||
return array_size<T>(array_capacity(array));
|
||||
}
|
||||
|
||||
template <typename T> T *allot_array_internal(cell capacity)
|
||||
{
|
||||
T *array = allot<T>(array_size<T>(capacity));
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
|
||||
{
|
||||
return in_zone(&nursery,array) && capacity <= array_capacity(array);
|
||||
}
|
||||
|
||||
template <typename T> T *reallot_array(T *array_, cell capacity)
|
||||
{
|
||||
gc_root<T> array(array_);
|
||||
|
||||
if(reallot_array_in_place_p(array.untagged(),capacity))
|
||||
{
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array.untagged();
|
||||
}
|
||||
else
|
||||
{
|
||||
cell to_copy = array_capacity(array.untagged());
|
||||
if(capacity < to_copy)
|
||||
to_copy = capacity;
|
||||
|
||||
T *new_array = allot_array_internal<T>(capacity);
|
||||
|
||||
memcpy(new_array + 1,array.untagged() + 1,to_copy * T::element_size);
|
||||
memset((char *)(new_array + 1) + to_copy * T::element_size,
|
||||
0,(capacity - to_copy) * T::element_size);
|
||||
|
||||
return new_array;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -4,7 +4,7 @@ namespace factor
|
|||
{
|
||||
|
||||
/* Certain special objects in the image are known to the runtime */
|
||||
static void init_objects(image_header *h)
|
||||
void factorvm::init_objects(image_header *h)
|
||||
{
|
||||
memcpy(userenv,h->userenv,sizeof(userenv));
|
||||
|
||||
|
@ -14,9 +14,9 @@ static void init_objects(image_header *h)
|
|||
bignum_neg_one = h->bignum_neg_one;
|
||||
}
|
||||
|
||||
cell data_relocation_base;
|
||||
|
||||
static void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
|
||||
|
||||
void factorvm::load_data_heap(FILE *file, image_header *h, vm_parameters *p)
|
||||
{
|
||||
cell good_size = h->data_size + (1 << 20);
|
||||
|
||||
|
@ -49,9 +49,9 @@ static void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
|
|||
data_relocation_base = h->data_relocation_base;
|
||||
}
|
||||
|
||||
cell code_relocation_base;
|
||||
|
||||
static void load_code_heap(FILE *file, image_header *h, vm_parameters *p)
|
||||
|
||||
void factorvm::load_code_heap(FILE *file, image_header *h, vm_parameters *p)
|
||||
{
|
||||
if(h->code_size > p->code_size)
|
||||
fatal_error("Code heap too small to fit image",h->code_size);
|
||||
|
@ -76,8 +76,9 @@ static void load_code_heap(FILE *file, image_header *h, vm_parameters *p)
|
|||
build_free_list(&code,h->code_size);
|
||||
}
|
||||
|
||||
|
||||
/* Save the current image to disk */
|
||||
bool save_image(const vm_char *filename)
|
||||
bool factorvm::save_image(const vm_char *filename)
|
||||
{
|
||||
FILE* file;
|
||||
image_header h;
|
||||
|
@ -122,23 +123,29 @@ bool save_image(const vm_char *filename)
|
|||
return ok;
|
||||
}
|
||||
|
||||
PRIMITIVE(save_image)
|
||||
|
||||
inline void factorvm::vmprim_save_image()
|
||||
{
|
||||
/* do a full GC to push everything into tenured space */
|
||||
gc();
|
||||
|
||||
gc_root<byte_array> path(dpop());
|
||||
path.untag_check();
|
||||
gc_root<byte_array> path(dpop(),this);
|
||||
path.untag_check(this);
|
||||
save_image((vm_char *)(path.untagged() + 1));
|
||||
}
|
||||
|
||||
PRIMITIVE(save_image_and_exit)
|
||||
{
|
||||
PRIMITIVE(save_image)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_save_image();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_save_image_and_exit()
|
||||
{
|
||||
/* We unbox this before doing anything else. This is the only point
|
||||
where we might throw an error, so we have to throw an error here since
|
||||
later steps destroy the current image. */
|
||||
gc_root<byte_array> path(dpop());
|
||||
path.untag_check();
|
||||
gc_root<byte_array> path(dpop(),this);
|
||||
path.untag_check(this);
|
||||
|
||||
/* strip out userenv data which is set on startup anyway */
|
||||
for(cell i = 0; i < USER_ENV; i++)
|
||||
|
@ -158,7 +165,12 @@ PRIMITIVE(save_image_and_exit)
|
|||
exit(1);
|
||||
}
|
||||
|
||||
static void data_fixup(cell *cell)
|
||||
PRIMITIVE(save_image_and_exit)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_save_image_and_exit();
|
||||
}
|
||||
|
||||
void factorvm::data_fixup(cell *cell)
|
||||
{
|
||||
if(immediate_p(*cell))
|
||||
return;
|
||||
|
@ -167,14 +179,20 @@ static void data_fixup(cell *cell)
|
|||
*cell += (tenured->start - data_relocation_base);
|
||||
}
|
||||
|
||||
template <typename T> void code_fixup(T **handle)
|
||||
void data_fixup(cell *cell, factorvm *myvm)
|
||||
{
|
||||
T *ptr = *handle;
|
||||
T *new_ptr = (T *)(((cell)ptr) + (code.seg->start - code_relocation_base));
|
||||
return myvm->data_fixup(cell);
|
||||
}
|
||||
|
||||
template <typename TYPE> void factorvm::code_fixup(TYPE **handle)
|
||||
{
|
||||
TYPE *ptr = *handle;
|
||||
TYPE *new_ptr = (TYPE *)(((cell)ptr) + (code.seg->start - code_relocation_base));
|
||||
*handle = new_ptr;
|
||||
}
|
||||
|
||||
static void fixup_word(word *word)
|
||||
|
||||
void factorvm::fixup_word(word *word)
|
||||
{
|
||||
if(word->code)
|
||||
code_fixup(&word->code);
|
||||
|
@ -183,7 +201,8 @@ static void fixup_word(word *word)
|
|||
code_fixup(&word->xt);
|
||||
}
|
||||
|
||||
static void fixup_quotation(quotation *quot)
|
||||
|
||||
void factorvm::fixup_quotation(quotation *quot)
|
||||
{
|
||||
if(quot->code)
|
||||
{
|
||||
|
@ -194,24 +213,32 @@ static void fixup_quotation(quotation *quot)
|
|||
quot->xt = (void *)lazy_jit_compile;
|
||||
}
|
||||
|
||||
static void fixup_alien(alien *d)
|
||||
|
||||
void factorvm::fixup_alien(alien *d)
|
||||
{
|
||||
d->expired = T;
|
||||
}
|
||||
|
||||
static void fixup_stack_frame(stack_frame *frame)
|
||||
|
||||
void factorvm::fixup_stack_frame(stack_frame *frame)
|
||||
{
|
||||
code_fixup(&frame->xt);
|
||||
code_fixup(&FRAME_RETURN_ADDRESS(frame));
|
||||
}
|
||||
|
||||
static void fixup_callstack_object(callstack *stack)
|
||||
void fixup_stack_frame(stack_frame *frame, factorvm *myvm)
|
||||
{
|
||||
iterate_callstack_object(stack,fixup_stack_frame);
|
||||
return myvm->fixup_stack_frame(frame);
|
||||
}
|
||||
|
||||
void factorvm::fixup_callstack_object(callstack *stack)
|
||||
{
|
||||
iterate_callstack_object(stack,factor::fixup_stack_frame);
|
||||
}
|
||||
|
||||
|
||||
/* Initialize an object in a newly-loaded image */
|
||||
static void relocate_object(object *object)
|
||||
void factorvm::relocate_object(object *object)
|
||||
{
|
||||
cell hi_tag = object->h.hi_tag();
|
||||
|
||||
|
@ -231,7 +258,7 @@ static void relocate_object(object *object)
|
|||
}
|
||||
else
|
||||
{
|
||||
do_slots((cell)object,data_fixup);
|
||||
do_slots((cell)object,factor::data_fixup);
|
||||
|
||||
switch(hi_tag)
|
||||
{
|
||||
|
@ -254,9 +281,10 @@ static void relocate_object(object *object)
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
/* Since the image might have been saved with a different base address than
|
||||
where it is loaded, we need to fix up pointers in the image. */
|
||||
void relocate_data()
|
||||
void factorvm::relocate_data()
|
||||
{
|
||||
cell relocating;
|
||||
|
||||
|
@ -281,7 +309,8 @@ void relocate_data()
|
|||
}
|
||||
}
|
||||
|
||||
static void fixup_code_block(code_block *compiled)
|
||||
|
||||
void factorvm::fixup_code_block(code_block *compiled)
|
||||
{
|
||||
/* relocate literal table data */
|
||||
data_fixup(&compiled->relocation);
|
||||
|
@ -290,14 +319,20 @@ static void fixup_code_block(code_block *compiled)
|
|||
relocate_code_block(compiled);
|
||||
}
|
||||
|
||||
void relocate_code()
|
||||
void fixup_code_block(code_block *compiled,factorvm *myvm)
|
||||
{
|
||||
iterate_code_heap(fixup_code_block);
|
||||
return myvm->fixup_code_block(compiled);
|
||||
}
|
||||
|
||||
void factorvm::relocate_code()
|
||||
{
|
||||
iterate_code_heap(factor::fixup_code_block);
|
||||
}
|
||||
|
||||
|
||||
/* Read an image file from disk, only done once during startup */
|
||||
/* This function also initializes the data and code heaps */
|
||||
void load_image(vm_parameters *p)
|
||||
void factorvm::load_image(vm_parameters *p)
|
||||
{
|
||||
FILE *file = OPEN_READ(p->image_path);
|
||||
if(file == NULL)
|
||||
|
@ -331,4 +366,5 @@ void load_image(vm_parameters *p)
|
|||
userenv[IMAGE_ENV] = allot_alien(F,(cell)p->image_path);
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
|
|
@ -41,9 +41,6 @@ struct vm_parameters {
|
|||
cell max_pic_size;
|
||||
};
|
||||
|
||||
void load_image(vm_parameters *p);
|
||||
bool save_image(const vm_char *file);
|
||||
|
||||
PRIMITIVE(save_image);
|
||||
PRIMITIVE(save_image_and_exit);
|
||||
|
||||
|
|
|
@ -3,21 +3,13 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
cell max_pic_size;
|
||||
|
||||
cell cold_call_to_ic_transitions;
|
||||
cell ic_to_pic_transitions;
|
||||
cell pic_to_mega_transitions;
|
||||
|
||||
/* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
|
||||
cell pic_counts[4];
|
||||
|
||||
void init_inline_caching(int max_size)
|
||||
void factorvm::init_inline_caching(int max_size)
|
||||
{
|
||||
max_pic_size = max_size;
|
||||
}
|
||||
|
||||
void deallocate_inline_cache(cell return_address)
|
||||
void factorvm::deallocate_inline_cache(cell return_address)
|
||||
{
|
||||
/* Find the call target. */
|
||||
void *old_xt = get_call_target(return_address);
|
||||
|
@ -38,7 +30,7 @@ void deallocate_inline_cache(cell return_address)
|
|||
|
||||
/* Figure out what kind of type check the PIC needs based on the methods
|
||||
it contains */
|
||||
static cell determine_inline_cache_type(array *cache_entries)
|
||||
cell factorvm::determine_inline_cache_type(array *cache_entries)
|
||||
{
|
||||
bool seen_hi_tag = false, seen_tuple = false;
|
||||
|
||||
|
@ -75,7 +67,7 @@ static cell determine_inline_cache_type(array *cache_entries)
|
|||
return 0;
|
||||
}
|
||||
|
||||
static void update_pic_count(cell type)
|
||||
void factorvm::update_pic_count(cell type)
|
||||
{
|
||||
pic_counts[type - PIC_TAG]++;
|
||||
}
|
||||
|
@ -83,7 +75,7 @@ static void update_pic_count(cell type)
|
|||
struct inline_cache_jit : public jit {
|
||||
fixnum index;
|
||||
|
||||
inline_cache_jit(cell generic_word_) : jit(PIC_TYPE,generic_word_) {};
|
||||
inline_cache_jit(cell generic_word_,factorvm *vm) : jit(PIC_TYPE,generic_word_,vm) {};
|
||||
|
||||
void emit_check(cell klass);
|
||||
void compile_inline_cache(fixnum index,
|
||||
|
@ -97,9 +89,9 @@ void inline_cache_jit::emit_check(cell klass)
|
|||
{
|
||||
cell code_template;
|
||||
if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE)
|
||||
code_template = userenv[PIC_CHECK_TAG];
|
||||
code_template = myvm->userenv[PIC_CHECK_TAG];
|
||||
else
|
||||
code_template = userenv[PIC_CHECK];
|
||||
code_template = myvm->userenv[PIC_CHECK];
|
||||
|
||||
emit_with(code_template,klass);
|
||||
}
|
||||
|
@ -112,12 +104,12 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
|
|||
cell cache_entries_,
|
||||
bool tail_call_p)
|
||||
{
|
||||
gc_root<word> generic_word(generic_word_);
|
||||
gc_root<array> methods(methods_);
|
||||
gc_root<array> cache_entries(cache_entries_);
|
||||
gc_root<word> generic_word(generic_word_,myvm);
|
||||
gc_root<array> methods(methods_,myvm);
|
||||
gc_root<array> cache_entries(cache_entries_,myvm);
|
||||
|
||||
cell inline_cache_type = determine_inline_cache_type(cache_entries.untagged());
|
||||
update_pic_count(inline_cache_type);
|
||||
cell inline_cache_type = myvm->determine_inline_cache_type(cache_entries.untagged());
|
||||
myvm->update_pic_count(inline_cache_type);
|
||||
|
||||
/* Generate machine code to determine the object's class. */
|
||||
emit_class_lookup(index,inline_cache_type);
|
||||
|
@ -132,7 +124,7 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
|
|||
|
||||
/* Yes? Jump to method */
|
||||
cell method = array_nth(cache_entries.untagged(),i + 1);
|
||||
emit_with(userenv[PIC_HIT],method);
|
||||
emit_with(myvm->userenv[PIC_HIT],method);
|
||||
}
|
||||
|
||||
/* Generate machine code to handle a cache miss, which ultimately results in
|
||||
|
@ -144,20 +136,16 @@ void inline_cache_jit::compile_inline_cache(fixnum index,
|
|||
push(methods.value());
|
||||
push(tag_fixnum(index));
|
||||
push(cache_entries.value());
|
||||
word_special(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
|
||||
word_special(myvm->userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
|
||||
}
|
||||
|
||||
static code_block *compile_inline_cache(fixnum index,
|
||||
cell generic_word_,
|
||||
cell methods_,
|
||||
cell cache_entries_,
|
||||
bool tail_call_p)
|
||||
code_block *factorvm::compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p)
|
||||
{
|
||||
gc_root<word> generic_word(generic_word_);
|
||||
gc_root<array> methods(methods_);
|
||||
gc_root<array> cache_entries(cache_entries_);
|
||||
gc_root<word> generic_word(generic_word_,this);
|
||||
gc_root<array> methods(methods_,this);
|
||||
gc_root<array> cache_entries(cache_entries_,this);
|
||||
|
||||
inline_cache_jit jit(generic_word.value());
|
||||
inline_cache_jit jit(generic_word.value(),this);
|
||||
jit.compile_inline_cache(index,
|
||||
generic_word.value(),
|
||||
methods.value(),
|
||||
|
@ -169,31 +157,31 @@ static code_block *compile_inline_cache(fixnum index,
|
|||
}
|
||||
|
||||
/* A generic word's definition performs general method lookup. Allocates memory */
|
||||
static void *megamorphic_call_stub(cell generic_word)
|
||||
void *factorvm::megamorphic_call_stub(cell generic_word)
|
||||
{
|
||||
return untag<word>(generic_word)->xt;
|
||||
}
|
||||
|
||||
static cell inline_cache_size(cell cache_entries)
|
||||
cell factorvm::inline_cache_size(cell cache_entries)
|
||||
{
|
||||
return array_capacity(untag_check<array>(cache_entries)) / 2;
|
||||
}
|
||||
|
||||
/* Allocates memory */
|
||||
static cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
|
||||
cell factorvm::add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
|
||||
{
|
||||
gc_root<array> cache_entries(cache_entries_);
|
||||
gc_root<object> klass(klass_);
|
||||
gc_root<word> method(method_);
|
||||
gc_root<array> cache_entries(cache_entries_,this);
|
||||
gc_root<object> klass(klass_,this);
|
||||
gc_root<word> method(method_,this);
|
||||
|
||||
cell pic_size = array_capacity(cache_entries.untagged());
|
||||
gc_root<array> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2));
|
||||
gc_root<array> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2),this);
|
||||
set_array_nth(new_cache_entries.untagged(),pic_size,klass.value());
|
||||
set_array_nth(new_cache_entries.untagged(),pic_size + 1,method.value());
|
||||
return new_cache_entries.value();
|
||||
}
|
||||
|
||||
static void update_pic_transitions(cell pic_size)
|
||||
void factorvm::update_pic_transitions(cell pic_size)
|
||||
{
|
||||
if(pic_size == max_pic_size)
|
||||
pic_to_mega_transitions++;
|
||||
|
@ -205,7 +193,7 @@ static void update_pic_transitions(cell pic_size)
|
|||
|
||||
/* The cache_entries parameter is either f (on cold call site) or an array (on cache miss).
|
||||
Called from assembly with the actual return address */
|
||||
void *inline_cache_miss(cell return_address)
|
||||
void *factorvm::inline_cache_miss(cell return_address)
|
||||
{
|
||||
check_code_pointer(return_address);
|
||||
|
||||
|
@ -214,11 +202,11 @@ void *inline_cache_miss(cell return_address)
|
|||
instead of leaving dead PICs around until the next GC. */
|
||||
deallocate_inline_cache(return_address);
|
||||
|
||||
gc_root<array> cache_entries(dpop());
|
||||
gc_root<array> cache_entries(dpop(),this);
|
||||
fixnum index = untag_fixnum(dpop());
|
||||
gc_root<array> methods(dpop());
|
||||
gc_root<word> generic_word(dpop());
|
||||
gc_root<object> object(((cell *)ds)[-index]);
|
||||
gc_root<array> methods(dpop(),this);
|
||||
gc_root<word> generic_word(dpop(),this);
|
||||
gc_root<object> object(((cell *)ds)[-index],this);
|
||||
|
||||
void *xt;
|
||||
|
||||
|
@ -236,7 +224,7 @@ void *inline_cache_miss(cell return_address)
|
|||
gc_root<array> new_cache_entries(add_inline_cache_entry(
|
||||
cache_entries.value(),
|
||||
klass,
|
||||
method));
|
||||
method),this);
|
||||
xt = compile_inline_cache(index,
|
||||
generic_word.value(),
|
||||
methods.value(),
|
||||
|
@ -257,16 +245,28 @@ void *inline_cache_miss(cell return_address)
|
|||
return xt;
|
||||
}
|
||||
|
||||
PRIMITIVE(reset_inline_cache_stats)
|
||||
VM_C_API void *inline_cache_miss(cell return_address, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->inline_cache_miss(return_address);
|
||||
}
|
||||
|
||||
|
||||
inline void factorvm::vmprim_reset_inline_cache_stats()
|
||||
{
|
||||
cold_call_to_ic_transitions = ic_to_pic_transitions = pic_to_mega_transitions = 0;
|
||||
cell i;
|
||||
for(i = 0; i < 4; i++) pic_counts[i] = 0;
|
||||
}
|
||||
|
||||
PRIMITIVE(inline_cache_stats)
|
||||
PRIMITIVE(reset_inline_cache_stats)
|
||||
{
|
||||
growable_array stats;
|
||||
PRIMITIVE_GETVM()->vmprim_reset_inline_cache_stats();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_inline_cache_stats()
|
||||
{
|
||||
growable_array stats(this);
|
||||
stats.add(allot_cell(cold_call_to_ic_transitions));
|
||||
stats.add(allot_cell(ic_to_pic_transitions));
|
||||
stats.add(allot_cell(pic_to_mega_transitions));
|
||||
|
@ -277,4 +277,9 @@ PRIMITIVE(inline_cache_stats)
|
|||
dpush(stats.elements.value());
|
||||
}
|
||||
|
||||
PRIMITIVE(inline_cache_stats)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_inline_cache_stats();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,15 +1,10 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
extern cell max_pic_size;
|
||||
|
||||
void init_inline_caching(int max_size);
|
||||
|
||||
PRIMITIVE(reset_inline_cache_stats);
|
||||
PRIMITIVE(inline_cache_stats);
|
||||
PRIMITIVE(inline_cache_miss);
|
||||
PRIMITIVE(inline_cache_miss_tail);
|
||||
|
||||
VM_C_API void *inline_cache_miss(cell return_address);
|
||||
VM_C_API void *inline_cache_miss(cell return_address, factorvm *vm);
|
||||
|
||||
}
|
||||
|
|
|
@ -0,0 +1,405 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
// I've had to copy inline implementations here to make dependencies work. Am hoping to move this code back into include files
|
||||
// once the rest of the reentrant changes are done. -PD
|
||||
|
||||
// segments.hpp
|
||||
|
||||
inline cell factorvm::align_page(cell a)
|
||||
{
|
||||
return align(a,getpagesize());
|
||||
}
|
||||
|
||||
// write_barrier.hpp
|
||||
|
||||
inline card *factorvm::addr_to_card(cell a)
|
||||
{
|
||||
return (card*)(((cell)(a) >> card_bits) + cards_offset);
|
||||
}
|
||||
|
||||
|
||||
inline cell factorvm::card_to_addr(card *c)
|
||||
{
|
||||
return ((cell)c - cards_offset) << card_bits;
|
||||
}
|
||||
|
||||
|
||||
inline cell factorvm::card_offset(card *c)
|
||||
{
|
||||
return *(c - (cell)data->cards + (cell)data->allot_markers);
|
||||
}
|
||||
|
||||
inline card_deck *factorvm::addr_to_deck(cell a)
|
||||
{
|
||||
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
|
||||
}
|
||||
|
||||
inline cell factorvm::deck_to_addr(card_deck *c)
|
||||
{
|
||||
return ((cell)c - decks_offset) << deck_bits;
|
||||
}
|
||||
|
||||
inline card *factorvm::deck_to_card(card_deck *d)
|
||||
{
|
||||
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
|
||||
}
|
||||
|
||||
inline card *factorvm::addr_to_allot_marker(object *a)
|
||||
{
|
||||
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
|
||||
}
|
||||
|
||||
/* the write barrier must be called any time we are potentially storing a
|
||||
pointer from an older generation to a younger one */
|
||||
inline void factorvm::write_barrier(object *obj)
|
||||
{
|
||||
*addr_to_card((cell)obj) = card_mark_mask;
|
||||
*addr_to_deck((cell)obj) = card_mark_mask;
|
||||
}
|
||||
|
||||
/* we need to remember the first object allocated in the card */
|
||||
inline void factorvm::allot_barrier(object *address)
|
||||
{
|
||||
card *ptr = addr_to_allot_marker(address);
|
||||
if(*ptr == invalid_allot_marker)
|
||||
*ptr = ((cell)address & addr_card_mask);
|
||||
}
|
||||
|
||||
|
||||
//data_gc.hpp
|
||||
inline bool factorvm::collecting_accumulation_gen_p()
|
||||
{
|
||||
return ((data->have_aging_p()
|
||||
&& collecting_gen == data->aging()
|
||||
&& !collecting_aging_again)
|
||||
|| collecting_gen == data->tenured());
|
||||
}
|
||||
|
||||
inline object *factorvm::allot_zone(zone *z, cell a)
|
||||
{
|
||||
cell h = z->here;
|
||||
z->here = h + align8(a);
|
||||
object *obj = (object *)h;
|
||||
allot_barrier(obj);
|
||||
return obj;
|
||||
}
|
||||
|
||||
/*
|
||||
* It is up to the caller to fill in the object's fields in a meaningful
|
||||
* fashion!
|
||||
*/
|
||||
inline object *factorvm::allot_object(header header, cell size)
|
||||
{
|
||||
#ifdef GC_DEBUG
|
||||
if(!gc_off)
|
||||
gc();
|
||||
#endif
|
||||
|
||||
object *obj;
|
||||
|
||||
if(nursery.size - allot_buffer_zone > size)
|
||||
{
|
||||
/* If there is insufficient room, collect the nursery */
|
||||
if(nursery.here + allot_buffer_zone + size > nursery.end)
|
||||
garbage_collection(data->nursery(),false,0);
|
||||
|
||||
cell h = nursery.here;
|
||||
nursery.here = h + align8(size);
|
||||
obj = (object *)h;
|
||||
}
|
||||
/* If the object is bigger than the nursery, allocate it in
|
||||
tenured space */
|
||||
else
|
||||
{
|
||||
zone *tenured = &data->generations[data->tenured()];
|
||||
|
||||
/* If tenured space does not have enough room, collect */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
gc();
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
/* If it still won't fit, grow the heap */
|
||||
if(tenured->here + size > tenured->end)
|
||||
{
|
||||
garbage_collection(data->tenured(),true,size);
|
||||
tenured = &data->generations[data->tenured()];
|
||||
}
|
||||
|
||||
obj = allot_zone(tenured,size);
|
||||
|
||||
/* Allows initialization code to store old->new pointers
|
||||
without hitting the write barrier in the common case of
|
||||
a nursery allocation */
|
||||
write_barrier(obj);
|
||||
}
|
||||
|
||||
obj->h = header;
|
||||
return obj;
|
||||
}
|
||||
|
||||
template<typename TYPE> TYPE *factorvm::allot(cell size)
|
||||
{
|
||||
return (TYPE *)allot_object(header(TYPE::type_number),size);
|
||||
}
|
||||
|
||||
inline void factorvm::check_data_pointer(object *pointer)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!growing_data_heap)
|
||||
{
|
||||
assert((cell)pointer >= data->seg->start
|
||||
&& (cell)pointer < data->seg->end);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
inline void factorvm::check_tagged_pointer(cell tagged)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
if(!immediate_p(tagged))
|
||||
{
|
||||
object *obj = untag<object>(tagged);
|
||||
check_data_pointer(obj);
|
||||
obj->h.hi_tag();
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
//local_roots.hpp
|
||||
template <typename TYPE>
|
||||
struct gc_root : public tagged<TYPE>
|
||||
{
|
||||
factorvm *myvm;
|
||||
|
||||
void push() { myvm->check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
|
||||
|
||||
explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
|
||||
explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
|
||||
|
||||
const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
|
||||
const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
|
||||
|
||||
~gc_root() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(myvm->gc_locals.back() == (cell)this);
|
||||
#endif
|
||||
myvm->gc_locals.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
/* A similar hack for the bignum implementation */
|
||||
struct gc_bignum
|
||||
{
|
||||
bignum **addr;
|
||||
factorvm *myvm;
|
||||
gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
|
||||
if(*addr_)
|
||||
myvm->check_data_pointer(*addr_);
|
||||
myvm->gc_bignums.push_back((cell)addr);
|
||||
}
|
||||
|
||||
~gc_bignum() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(myvm->gc_bignums.back() == (cell)addr);
|
||||
#endif
|
||||
myvm->gc_bignums.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
|
||||
|
||||
//generic_arrays.hpp
|
||||
template <typename TYPE> TYPE *factorvm::allot_array_internal(cell capacity)
|
||||
{
|
||||
TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
template <typename TYPE> bool factorvm::reallot_array_in_place_p(TYPE *array, cell capacity)
|
||||
{
|
||||
return in_zone(&nursery,array) && capacity <= array_capacity(array);
|
||||
}
|
||||
|
||||
template <typename TYPE> TYPE *factorvm::reallot_array(TYPE *array_, cell capacity)
|
||||
{
|
||||
gc_root<TYPE> array(array_,this);
|
||||
|
||||
if(reallot_array_in_place_p(array.untagged(),capacity))
|
||||
{
|
||||
array->capacity = tag_fixnum(capacity);
|
||||
return array.untagged();
|
||||
}
|
||||
else
|
||||
{
|
||||
cell to_copy = array_capacity(array.untagged());
|
||||
if(capacity < to_copy)
|
||||
to_copy = capacity;
|
||||
|
||||
TYPE *new_array = allot_array_internal<TYPE>(capacity);
|
||||
|
||||
memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
|
||||
memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
|
||||
0,(capacity - to_copy) * TYPE::element_size);
|
||||
|
||||
return new_array;
|
||||
}
|
||||
}
|
||||
|
||||
//arrays.hpp
|
||||
inline void factorvm::set_array_nth(array *array, cell slot, cell value)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(slot < array_capacity(array));
|
||||
assert(array->h.hi_tag() == ARRAY_TYPE);
|
||||
check_tagged_pointer(value);
|
||||
#endif
|
||||
array->data()[slot] = value;
|
||||
write_barrier(array);
|
||||
}
|
||||
|
||||
struct growable_array {
|
||||
cell count;
|
||||
gc_root<array> elements;
|
||||
|
||||
growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
|
||||
|
||||
void add(cell elt);
|
||||
void trim();
|
||||
};
|
||||
|
||||
//byte_arrays.hpp
|
||||
struct growable_byte_array {
|
||||
cell count;
|
||||
gc_root<byte_array> elements;
|
||||
|
||||
growable_byte_array(factorvm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
|
||||
|
||||
void append_bytes(void *elts, cell len);
|
||||
void append_byte_array(cell elts);
|
||||
|
||||
void trim();
|
||||
};
|
||||
|
||||
//math.hpp
|
||||
inline cell factorvm::allot_integer(fixnum x)
|
||||
{
|
||||
if(x < fixnum_min || x > fixnum_max)
|
||||
return tag<bignum>(fixnum_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
inline cell factorvm::allot_cell(cell x)
|
||||
{
|
||||
if(x > (cell)fixnum_max)
|
||||
return tag<bignum>(cell_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
inline cell factorvm::allot_float(double n)
|
||||
{
|
||||
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
|
||||
flo->n = n;
|
||||
return tag(flo);
|
||||
}
|
||||
|
||||
inline bignum *factorvm::float_to_bignum(cell tagged)
|
||||
{
|
||||
return double_to_bignum(untag_float(tagged));
|
||||
}
|
||||
|
||||
inline double factorvm::bignum_to_float(cell tagged)
|
||||
{
|
||||
return bignum_to_double(untag<bignum>(tagged));
|
||||
}
|
||||
|
||||
inline double factorvm::untag_float(cell tagged)
|
||||
{
|
||||
return untag<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline double factorvm::untag_float_check(cell tagged)
|
||||
{
|
||||
return untag_check<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline fixnum factorvm::float_to_fixnum(cell tagged)
|
||||
{
|
||||
return (fixnum)untag_float(tagged);
|
||||
}
|
||||
|
||||
inline double factorvm::fixnum_to_float(cell tagged)
|
||||
{
|
||||
return (double)untag_fixnum(tagged);
|
||||
}
|
||||
|
||||
//callstack.hpp
|
||||
/* This is a little tricky. The iterator may allocate memory, so we
|
||||
keep the callstack in a GC root and use relative offsets */
|
||||
template<typename TYPE> void factorvm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
|
||||
{
|
||||
gc_root<callstack> stack(stack_,this);
|
||||
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
|
||||
|
||||
while(frame_offset >= 0)
|
||||
{
|
||||
stack_frame *frame = stack->frame_at(frame_offset);
|
||||
frame_offset -= frame->size;
|
||||
iterator(frame,this);
|
||||
}
|
||||
}
|
||||
|
||||
//booleans.hpp
|
||||
inline cell factorvm::tag_boolean(cell untagged)
|
||||
{
|
||||
return (untagged ? T : F);
|
||||
}
|
||||
|
||||
// callstack.hpp
|
||||
template<typename TYPE> void factorvm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
|
||||
{
|
||||
stack_frame *frame = (stack_frame *)bottom - 1;
|
||||
|
||||
while((cell)frame >= top)
|
||||
{
|
||||
iterator(frame,this);
|
||||
frame = frame_successor(frame);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// data_heap.hpp
|
||||
/* Every object has a regular representation in the runtime, which makes GC
|
||||
much simpler. Every slot of the object until binary_payload_start is a pointer
|
||||
to some other object. */
|
||||
struct factorvm;
|
||||
inline void factorvm::do_slots(cell obj, void (* iter)(cell *,factorvm*))
|
||||
{
|
||||
cell scan = obj;
|
||||
cell payload_start = binary_payload_start((object *)obj);
|
||||
cell end = obj + payload_start;
|
||||
|
||||
scan += sizeof(cell);
|
||||
|
||||
while(scan < end)
|
||||
{
|
||||
iter((cell *)scan,this);
|
||||
scan += sizeof(cell);
|
||||
}
|
||||
}
|
||||
|
||||
// code_heap.hpp
|
||||
|
||||
inline void factorvm::check_code_pointer(cell ptr)
|
||||
{
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(in_code_heap_p(ptr));
|
||||
#endif
|
||||
}
|
||||
|
||||
}
|
|
@ -14,14 +14,15 @@ The Factor library provides platform-specific code for Unix and Windows
|
|||
with many more capabilities so these words are not usually used in
|
||||
normal operation. */
|
||||
|
||||
void init_c_io()
|
||||
void factorvm::init_c_io()
|
||||
{
|
||||
userenv[STDIN_ENV] = allot_alien(F,(cell)stdin);
|
||||
userenv[STDOUT_ENV] = allot_alien(F,(cell)stdout);
|
||||
userenv[STDERR_ENV] = allot_alien(F,(cell)stderr);
|
||||
}
|
||||
|
||||
void io_error()
|
||||
|
||||
void factorvm::io_error()
|
||||
{
|
||||
#ifndef WINCE
|
||||
if(errno == EINTR)
|
||||
|
@ -31,12 +32,13 @@ void io_error()
|
|||
general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
|
||||
}
|
||||
|
||||
PRIMITIVE(fopen)
|
||||
|
||||
inline void factorvm::vmprim_fopen()
|
||||
{
|
||||
gc_root<byte_array> mode(dpop());
|
||||
gc_root<byte_array> path(dpop());
|
||||
mode.untag_check();
|
||||
path.untag_check();
|
||||
gc_root<byte_array> mode(dpop(),this);
|
||||
gc_root<byte_array> path(dpop(),this);
|
||||
mode.untag_check(this);
|
||||
path.untag_check(this);
|
||||
|
||||
for(;;)
|
||||
{
|
||||
|
@ -52,7 +54,12 @@ PRIMITIVE(fopen)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fgetc)
|
||||
PRIMITIVE(fopen)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fopen();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fgetc()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
|
||||
|
@ -77,7 +84,12 @@ PRIMITIVE(fgetc)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fread)
|
||||
PRIMITIVE(fgetc)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fgetc();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fread()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
fixnum size = unbox_array_size();
|
||||
|
@ -88,7 +100,7 @@ PRIMITIVE(fread)
|
|||
return;
|
||||
}
|
||||
|
||||
gc_root<byte_array> buf(allot_array_internal<byte_array>(size));
|
||||
gc_root<byte_array> buf(allot_array_internal<byte_array>(size),this);
|
||||
|
||||
for(;;)
|
||||
{
|
||||
|
@ -117,7 +129,12 @@ PRIMITIVE(fread)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fputc)
|
||||
PRIMITIVE(fread)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fread();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fputc()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
fixnum ch = to_fixnum(dpop());
|
||||
|
@ -135,7 +152,12 @@ PRIMITIVE(fputc)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fwrite)
|
||||
PRIMITIVE(fputc)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fputc();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fwrite()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
byte_array *text = untag_check<byte_array>(dpop());
|
||||
|
@ -164,7 +186,12 @@ PRIMITIVE(fwrite)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fseek)
|
||||
PRIMITIVE(fwrite)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fwrite();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fseek()
|
||||
{
|
||||
int whence = to_fixnum(dpop());
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
|
@ -189,7 +216,12 @@ PRIMITIVE(fseek)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fflush)
|
||||
PRIMITIVE(fseek)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fseek();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fflush()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
for(;;)
|
||||
|
@ -201,7 +233,12 @@ PRIMITIVE(fflush)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fclose)
|
||||
PRIMITIVE(fflush)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fflush();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fclose()
|
||||
{
|
||||
FILE *file = (FILE *)unbox_alien();
|
||||
for(;;)
|
||||
|
@ -213,6 +250,11 @@ PRIMITIVE(fclose)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fclose)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fclose();
|
||||
}
|
||||
|
||||
/* This function is used by FFI I/O. Accessing the errno global directly is
|
||||
not portable, since on some libc's errno is not a global but a funky macro that
|
||||
reads thread-local storage. */
|
||||
|
@ -225,5 +267,4 @@ VM_C_API void clear_err_no()
|
|||
{
|
||||
errno = 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,9 +1,6 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
void init_c_io();
|
||||
void io_error();
|
||||
|
||||
PRIMITIVE(fopen);
|
||||
PRIMITIVE(fgetc);
|
||||
PRIMITIVE(fread);
|
||||
|
|
31
vm/jit.cpp
31
vm/jit.cpp
|
@ -10,22 +10,23 @@ namespace factor
|
|||
- polymorphic inline caches (inline_cache.cpp) */
|
||||
|
||||
/* Allocates memory */
|
||||
jit::jit(cell type_, cell owner_)
|
||||
jit::jit(cell type_, cell owner_, factorvm *vm)
|
||||
: type(type_),
|
||||
owner(owner_),
|
||||
code(),
|
||||
relocation(),
|
||||
literals(),
|
||||
owner(owner_,vm),
|
||||
code(vm),
|
||||
relocation(vm),
|
||||
literals(vm),
|
||||
computing_offset_p(false),
|
||||
position(0),
|
||||
offset(0)
|
||||
offset(0),
|
||||
myvm(vm)
|
||||
{
|
||||
if(stack_traces_p()) literal(owner.value());
|
||||
if(myvm->stack_traces_p()) literal(owner.value());
|
||||
}
|
||||
|
||||
void jit::emit_relocation(cell code_template_)
|
||||
{
|
||||
gc_root<array> code_template(code_template_);
|
||||
gc_root<array> code_template(code_template_,myvm);
|
||||
cell capacity = array_capacity(code_template.untagged());
|
||||
for(cell i = 1; i < capacity; i += 3)
|
||||
{
|
||||
|
@ -44,11 +45,11 @@ void jit::emit_relocation(cell code_template_)
|
|||
/* Allocates memory */
|
||||
void jit::emit(cell code_template_)
|
||||
{
|
||||
gc_root<array> code_template(code_template_);
|
||||
gc_root<array> code_template(code_template_,myvm);
|
||||
|
||||
emit_relocation(code_template.value());
|
||||
|
||||
gc_root<byte_array> insns(array_nth(code_template.untagged(),0));
|
||||
gc_root<byte_array> insns(array_nth(code_template.untagged(),0),myvm);
|
||||
|
||||
if(computing_offset_p)
|
||||
{
|
||||
|
@ -72,16 +73,16 @@ void jit::emit(cell code_template_)
|
|||
}
|
||||
|
||||
void jit::emit_with(cell code_template_, cell argument_) {
|
||||
gc_root<array> code_template(code_template_);
|
||||
gc_root<object> argument(argument_);
|
||||
gc_root<array> code_template(code_template_,myvm);
|
||||
gc_root<object> argument(argument_,myvm);
|
||||
literal(argument.value());
|
||||
emit(code_template.value());
|
||||
}
|
||||
|
||||
void jit::emit_class_lookup(fixnum index, cell type)
|
||||
{
|
||||
emit_with(userenv[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
|
||||
emit(userenv[type]);
|
||||
emit_with(myvm->userenv[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
|
||||
emit(myvm->userenv[type]);
|
||||
}
|
||||
|
||||
/* Facility to convert compiled code offsets to quotation offsets.
|
||||
|
@ -101,7 +102,7 @@ code_block *jit::to_code_block()
|
|||
relocation.trim();
|
||||
literals.trim();
|
||||
|
||||
return add_code_block(
|
||||
return myvm->add_code_block(
|
||||
type,
|
||||
code.elements.value(),
|
||||
F, /* no labels */
|
||||
|
|
17
vm/jit.hpp
17
vm/jit.hpp
|
@ -10,8 +10,9 @@ struct jit {
|
|||
bool computing_offset_p;
|
||||
fixnum position;
|
||||
cell offset;
|
||||
factorvm *myvm;
|
||||
|
||||
jit(cell jit_type, cell owner);
|
||||
jit(cell jit_type, cell owner, factorvm *vm);
|
||||
void compute_position(cell offset);
|
||||
|
||||
void emit_relocation(cell code_template);
|
||||
|
@ -21,27 +22,27 @@ struct jit {
|
|||
void emit_with(cell code_template_, cell literal_);
|
||||
|
||||
void push(cell literal) {
|
||||
emit_with(userenv[JIT_PUSH_IMMEDIATE],literal);
|
||||
emit_with(myvm->userenv[JIT_PUSH_IMMEDIATE],literal);
|
||||
}
|
||||
|
||||
void word_jump(cell word) {
|
||||
literal(tag_fixnum(xt_tail_pic_offset));
|
||||
literal(word);
|
||||
emit(userenv[JIT_WORD_JUMP]);
|
||||
emit(myvm->userenv[JIT_WORD_JUMP]);
|
||||
}
|
||||
|
||||
void word_call(cell word) {
|
||||
emit_with(userenv[JIT_WORD_CALL],word);
|
||||
emit_with(myvm->userenv[JIT_WORD_CALL],word);
|
||||
}
|
||||
|
||||
void word_special(cell word) {
|
||||
emit_with(userenv[JIT_WORD_SPECIAL],word);
|
||||
emit_with(myvm->userenv[JIT_WORD_SPECIAL],word);
|
||||
}
|
||||
|
||||
void emit_subprimitive(cell word_) {
|
||||
gc_root<word> word(word_);
|
||||
gc_root<array> code_template(word->subprimitive);
|
||||
if(array_capacity(code_template.untagged()) > 1) literal(T);
|
||||
gc_root<word> word(word_,myvm);
|
||||
gc_root<array> code_template(word->subprimitive,myvm);
|
||||
if(array_capacity(code_template.untagged()) > 1) literal(myvm->T);
|
||||
emit(code_template.value());
|
||||
}
|
||||
|
||||
|
|
|
@ -2,9 +2,4 @@
|
|||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
std::vector<cell> gc_locals;
|
||||
|
||||
std::vector<cell> gc_bignums;
|
||||
|
||||
}
|
||||
|
|
|
@ -1,51 +1,3 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
/* If a runtime function needs to call another function which potentially
|
||||
allocates memory, it must wrap any local variable references to Factor
|
||||
objects in gc_root instances */
|
||||
extern std::vector<cell> gc_locals;
|
||||
|
||||
template <typename T>
|
||||
struct gc_root : public tagged<T>
|
||||
{
|
||||
void push() { check_tagged_pointer(tagged<T>::value()); gc_locals.push_back((cell)this); }
|
||||
|
||||
explicit gc_root(cell value_) : tagged<T>(value_) { push(); }
|
||||
explicit gc_root(T *value_) : tagged<T>(value_) { push(); }
|
||||
|
||||
const gc_root<T>& operator=(const T *x) { tagged<T>::operator=(x); return *this; }
|
||||
const gc_root<T>& operator=(const cell &x) { tagged<T>::operator=(x); return *this; }
|
||||
|
||||
~gc_root() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(gc_locals.back() == (cell)this);
|
||||
#endif
|
||||
gc_locals.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
/* A similar hack for the bignum implementation */
|
||||
extern std::vector<cell> gc_bignums;
|
||||
|
||||
struct gc_bignum
|
||||
{
|
||||
bignum **addr;
|
||||
|
||||
gc_bignum(bignum **addr_) : addr(addr_) {
|
||||
if(*addr_)
|
||||
check_data_pointer(*addr_);
|
||||
gc_bignums.push_back((cell)addr);
|
||||
}
|
||||
|
||||
~gc_bignum() {
|
||||
#ifdef FACTOR_DEBUG
|
||||
assert(gc_bignums.back() == (cell)addr);
|
||||
#endif
|
||||
gc_bignums.pop_back();
|
||||
}
|
||||
};
|
||||
|
||||
#define GC_BIGNUM(x) gc_bignum x##__gc_root(&x)
|
||||
|
||||
}
|
||||
|
|
|
@ -28,7 +28,7 @@ http://www.wodeveloper.com/omniLists/macosx-dev/2000/June/msg00137.html */
|
|||
/* Modify a suspended thread's thread_state so that when the thread resumes
|
||||
executing, the call frame of the current C primitive (if any) is rewound, and
|
||||
the appropriate Factor error is thrown from the top-most Factor frame. */
|
||||
static void call_fault_handler(
|
||||
void factorvm::call_fault_handler(
|
||||
exception_type_t exception,
|
||||
exception_data_type_t code,
|
||||
MACH_EXC_STATE_TYPE *exc_state,
|
||||
|
@ -53,21 +53,30 @@ static void call_fault_handler(
|
|||
if(exception == EXC_BAD_ACCESS)
|
||||
{
|
||||
signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
|
||||
MACH_PROGRAM_COUNTER(thread_state) = (cell)memory_signal_handler_impl;
|
||||
MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::memory_signal_handler_impl;
|
||||
}
|
||||
else if(exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV)
|
||||
{
|
||||
signal_fpu_status = fpu_status(mach_fpu_status(float_state));
|
||||
mach_clear_fpu_status(float_state);
|
||||
MACH_PROGRAM_COUNTER(thread_state) = (cell)fp_signal_handler_impl;
|
||||
signal_fpu_status = fpu_status(mach_fpu_status(float_state));
|
||||
mach_clear_fpu_status(float_state);
|
||||
MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::fp_signal_handler_impl;
|
||||
}
|
||||
else
|
||||
{
|
||||
signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
|
||||
MACH_PROGRAM_COUNTER(thread_state) = (cell)misc_signal_handler_impl;
|
||||
MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::misc_signal_handler_impl;
|
||||
}
|
||||
}
|
||||
|
||||
static void call_fault_handler(exception_type_t exception,
|
||||
exception_data_type_t code,
|
||||
MACH_EXC_STATE_TYPE *exc_state,
|
||||
MACH_THREAD_STATE_TYPE *thread_state,
|
||||
MACH_FLOAT_STATE_TYPE *float_state)
|
||||
{
|
||||
SIGNAL_VM_PTR()->call_fault_handler(exception,code,exc_state,thread_state,float_state);
|
||||
}
|
||||
|
||||
/* Handle an exception by invoking the user's fault handler and/or forwarding
|
||||
the duty to the previously installed handlers. */
|
||||
extern "C"
|
||||
|
@ -215,7 +224,7 @@ void mach_initialize ()
|
|||
mask = EXC_MASK_BAD_ACCESS | EXC_MASK_ARITHMETIC;
|
||||
|
||||
/* Create the thread listening on the exception port. */
|
||||
start_thread(mach_exception_thread);
|
||||
start_thread(mach_exception_thread,NULL);
|
||||
|
||||
/* Replace the exception port info for these exceptions with our own.
|
||||
Note that we replace the exception port for the entire task, not only
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
factor::init_globals();
|
||||
factor::start_standalone_factor(argc,argv);
|
||||
return 0;
|
||||
}
|
||||
|
|
|
@ -16,7 +16,13 @@ int WINAPI WinMain(
|
|||
return 1;
|
||||
}
|
||||
|
||||
factor::init_globals();
|
||||
#ifdef FACTOR_MULTITHREADED
|
||||
factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(nArgs,szArglist);
|
||||
WaitForSingleObject(thread, INFINITE);
|
||||
#else
|
||||
factor::start_standalone_factor(nArgs,szArglist);
|
||||
#endif
|
||||
|
||||
LocalFree(szArglist);
|
||||
|
||||
|
|
|
@ -1,6 +1,9 @@
|
|||
#ifndef __FACTOR_MASTER_H__
|
||||
#define __FACTOR_MASTER_H__
|
||||
|
||||
#define _THREAD_SAFE
|
||||
#define _REENTRANT
|
||||
|
||||
#ifndef WINCE
|
||||
#include <errno.h>
|
||||
#endif
|
||||
|
@ -41,11 +44,11 @@
|
|||
#include "segments.hpp"
|
||||
#include "contexts.hpp"
|
||||
#include "run.hpp"
|
||||
#include "tagged.hpp"
|
||||
#include "profiler.hpp"
|
||||
#include "errors.hpp"
|
||||
#include "bignumint.hpp"
|
||||
#include "bignum.hpp"
|
||||
#include "code_block.hpp"
|
||||
#include "data_heap.hpp"
|
||||
#include "write_barrier.hpp"
|
||||
#include "data_gc.hpp"
|
||||
|
@ -62,11 +65,13 @@
|
|||
#include "float_bits.hpp"
|
||||
#include "io.hpp"
|
||||
#include "code_gc.hpp"
|
||||
#include "code_block.hpp"
|
||||
#include "code_heap.hpp"
|
||||
#include "image.hpp"
|
||||
#include "callstack.hpp"
|
||||
#include "alien.hpp"
|
||||
#include "vm.hpp"
|
||||
#include "tagged.hpp"
|
||||
#include "inlineimpls.hpp"
|
||||
#include "jit.hpp"
|
||||
#include "quotations.hpp"
|
||||
#include "dispatch.hpp"
|
||||
|
@ -74,4 +79,6 @@
|
|||
#include "factor.hpp"
|
||||
#include "utilities.hpp"
|
||||
|
||||
|
||||
|
||||
#endif /* __FACTOR_MASTER_H__ */
|
||||
|
|
|
@ -3,23 +3,29 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
cell bignum_zero;
|
||||
cell bignum_pos_one;
|
||||
cell bignum_neg_one;
|
||||
|
||||
PRIMITIVE(bignum_to_fixnum)
|
||||
inline void factorvm::vmprim_bignum_to_fixnum()
|
||||
{
|
||||
drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE(float_to_fixnum)
|
||||
PRIMITIVE(bignum_to_fixnum)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_to_fixnum();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_to_fixnum()
|
||||
{
|
||||
drepl(tag_fixnum(float_to_fixnum(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE(float_to_fixnum)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_to_fixnum();
|
||||
}
|
||||
|
||||
/* Division can only overflow when we are dividing the most negative fixnum
|
||||
by -1. */
|
||||
PRIMITIVE(fixnum_divint)
|
||||
inline void factorvm::vmprim_fixnum_divint()
|
||||
{
|
||||
fixnum y = untag_fixnum(dpop()); \
|
||||
fixnum x = untag_fixnum(dpeek());
|
||||
|
@ -30,7 +36,12 @@ PRIMITIVE(fixnum_divint)
|
|||
drepl(tag_fixnum(result));
|
||||
}
|
||||
|
||||
PRIMITIVE(fixnum_divmod)
|
||||
PRIMITIVE(fixnum_divint)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fixnum_divint();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fixnum_divmod()
|
||||
{
|
||||
cell y = ((cell *)ds)[0];
|
||||
cell x = ((cell *)ds)[-1];
|
||||
|
@ -46,26 +57,34 @@ PRIMITIVE(fixnum_divmod)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(fixnum_divmod)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fixnum_divmod();
|
||||
}
|
||||
|
||||
/*
|
||||
* If we're shifting right by n bits, we won't overflow as long as none of the
|
||||
* high WORD_SIZE-TAG_BITS-n bits are set.
|
||||
*/
|
||||
static inline fixnum sign_mask(fixnum x)
|
||||
inline fixnum factorvm::sign_mask(fixnum x)
|
||||
{
|
||||
return x >> (WORD_SIZE - 1);
|
||||
}
|
||||
|
||||
static inline fixnum branchless_max(fixnum x, fixnum y)
|
||||
|
||||
inline fixnum factorvm::branchless_max(fixnum x, fixnum y)
|
||||
{
|
||||
return (x - ((x - y) & sign_mask(x - y)));
|
||||
}
|
||||
|
||||
static inline fixnum branchless_abs(fixnum x)
|
||||
|
||||
inline fixnum factorvm::branchless_abs(fixnum x)
|
||||
{
|
||||
return (x ^ sign_mask(x)) - sign_mask(x);
|
||||
}
|
||||
|
||||
PRIMITIVE(fixnum_shift)
|
||||
|
||||
inline void factorvm::vmprim_fixnum_shift()
|
||||
{
|
||||
fixnum y = untag_fixnum(dpop());
|
||||
fixnum x = untag_fixnum(dpeek());
|
||||
|
@ -92,51 +111,91 @@ PRIMITIVE(fixnum_shift)
|
|||
fixnum_to_bignum(x),y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(fixnum_to_bignum)
|
||||
PRIMITIVE(fixnum_shift)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fixnum_shift();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_fixnum_to_bignum()
|
||||
{
|
||||
drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE(float_to_bignum)
|
||||
PRIMITIVE(fixnum_to_bignum)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fixnum_to_bignum();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_to_bignum()
|
||||
{
|
||||
drepl(tag<bignum>(float_to_bignum(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE(float_to_bignum)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_to_bignum();
|
||||
}
|
||||
|
||||
#define POP_BIGNUMS(x,y) \
|
||||
bignum * y = untag<bignum>(dpop()); \
|
||||
bignum * x = untag<bignum>(dpop());
|
||||
|
||||
PRIMITIVE(bignum_eq)
|
||||
inline void factorvm::vmprim_bignum_eq()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_equal_p(x,y));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_add)
|
||||
PRIMITIVE(bignum_eq)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_eq();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_add()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_add(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_subtract)
|
||||
PRIMITIVE(bignum_add)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_add();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_subtract()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_subtract(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_multiply)
|
||||
PRIMITIVE(bignum_subtract)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_subtract();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_multiply()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_multiply(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_divint)
|
||||
PRIMITIVE(bignum_multiply)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_multiply();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_divint()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_quotient(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_divmod)
|
||||
PRIMITIVE(bignum_divint)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_divint();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_divmod()
|
||||
{
|
||||
bignum *q, *r;
|
||||
POP_BIGNUMS(x,y);
|
||||
|
@ -145,92 +204,168 @@ PRIMITIVE(bignum_divmod)
|
|||
dpush(tag<bignum>(r));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_mod)
|
||||
PRIMITIVE(bignum_divmod)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_divmod();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_mod()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_remainder(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_and)
|
||||
PRIMITIVE(bignum_mod)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_mod();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_and()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_bitwise_and(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_or)
|
||||
PRIMITIVE(bignum_and)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_and();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_or()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_xor)
|
||||
PRIMITIVE(bignum_or)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_or();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_xor()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_shift)
|
||||
PRIMITIVE(bignum_xor)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_xor();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_shift()
|
||||
{
|
||||
fixnum y = untag_fixnum(dpop());
|
||||
bignum* x = untag<bignum>(dpop());
|
||||
dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_less)
|
||||
PRIMITIVE(bignum_shift)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_shift();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_less()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) == bignum_comparison_less);
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_lesseq)
|
||||
PRIMITIVE(bignum_less)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_less();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_lesseq()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_greater)
|
||||
PRIMITIVE(bignum_lesseq)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_lesseq();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_greater()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_greatereq)
|
||||
PRIMITIVE(bignum_greater)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_greater();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_greatereq()
|
||||
{
|
||||
POP_BIGNUMS(x,y);
|
||||
box_boolean(bignum_compare(x,y) != bignum_comparison_less);
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_not)
|
||||
PRIMITIVE(bignum_greatereq)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_greatereq();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_not()
|
||||
{
|
||||
drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_bitp)
|
||||
PRIMITIVE(bignum_not)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_not();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_bitp()
|
||||
{
|
||||
fixnum bit = to_fixnum(dpop());
|
||||
bignum *x = untag<bignum>(dpop());
|
||||
box_boolean(bignum_logbitp(bit,x));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_log2)
|
||||
PRIMITIVE(bignum_bitp)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_bitp();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_log2()
|
||||
{
|
||||
drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
|
||||
}
|
||||
|
||||
unsigned int bignum_producer(unsigned int digit)
|
||||
PRIMITIVE(bignum_log2)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_log2();
|
||||
}
|
||||
|
||||
unsigned int factorvm::bignum_producer(unsigned int digit)
|
||||
{
|
||||
unsigned char *ptr = (unsigned char *)alien_offset(dpeek());
|
||||
return *(ptr + digit);
|
||||
}
|
||||
|
||||
PRIMITIVE(byte_array_to_bignum)
|
||||
unsigned int bignum_producer(unsigned int digit, factorvm *myvm)
|
||||
{
|
||||
return myvm->bignum_producer(digit);
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_byte_array_to_bignum()
|
||||
{
|
||||
cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
|
||||
bignum * result = digit_stream_to_bignum(n_digits,bignum_producer,0x100,0);
|
||||
// bignum * result = factor::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));
|
||||
}
|
||||
|
||||
cell unbox_array_size()
|
||||
PRIMITIVE(byte_array_to_bignum)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_byte_array_to_bignum();
|
||||
}
|
||||
|
||||
cell factorvm::unbox_array_size()
|
||||
{
|
||||
switch(tagged<object>(dpeek()).type())
|
||||
{
|
||||
|
@ -263,17 +398,28 @@ cell unbox_array_size()
|
|||
return 0; /* can't happen */
|
||||
}
|
||||
|
||||
PRIMITIVE(fixnum_to_float)
|
||||
|
||||
inline void factorvm::vmprim_fixnum_to_float()
|
||||
{
|
||||
drepl(allot_float(fixnum_to_float(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE(bignum_to_float)
|
||||
PRIMITIVE(fixnum_to_float)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_fixnum_to_float();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bignum_to_float()
|
||||
{
|
||||
drepl(allot_float(bignum_to_float(dpeek())));
|
||||
}
|
||||
|
||||
PRIMITIVE(str_to_float)
|
||||
PRIMITIVE(bignum_to_float)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bignum_to_float();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_str_to_float()
|
||||
{
|
||||
byte_array *bytes = untag_check<byte_array>(dpeek());
|
||||
cell capacity = array_capacity(bytes);
|
||||
|
@ -287,98 +433,178 @@ PRIMITIVE(str_to_float)
|
|||
drepl(F);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_to_str)
|
||||
PRIMITIVE(str_to_float)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_str_to_float();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_to_str()
|
||||
{
|
||||
byte_array *array = allot_byte_array(33);
|
||||
snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
|
||||
dpush(tag<byte_array>(array));
|
||||
}
|
||||
|
||||
PRIMITIVE(float_to_str)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_to_str();
|
||||
}
|
||||
|
||||
#define POP_FLOATS(x,y) \
|
||||
double y = untag_float(dpop()); \
|
||||
double x = untag_float(dpop());
|
||||
|
||||
PRIMITIVE(float_eq)
|
||||
inline void factorvm::vmprim_float_eq()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x == y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_add)
|
||||
PRIMITIVE(float_eq)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_eq();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_add()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x + y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_subtract)
|
||||
PRIMITIVE(float_add)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_add();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_subtract()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x - y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_multiply)
|
||||
PRIMITIVE(float_subtract)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_subtract();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_multiply()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x * y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_divfloat)
|
||||
PRIMITIVE(float_multiply)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_multiply();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_divfloat()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(x / y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_mod)
|
||||
PRIMITIVE(float_divfloat)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_divfloat();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_mod()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_double(fmod(x,y));
|
||||
}
|
||||
|
||||
PRIMITIVE(float_less)
|
||||
PRIMITIVE(float_mod)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_mod();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_less()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x < y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_lesseq)
|
||||
PRIMITIVE(float_less)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_less();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_lesseq()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x <= y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_greater)
|
||||
PRIMITIVE(float_lesseq)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_lesseq();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_greater()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x > y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_greatereq)
|
||||
PRIMITIVE(float_greater)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_greater();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_greatereq()
|
||||
{
|
||||
POP_FLOATS(x,y);
|
||||
box_boolean(x >= y);
|
||||
}
|
||||
|
||||
PRIMITIVE(float_bits)
|
||||
PRIMITIVE(float_greatereq)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_greatereq();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_float_bits()
|
||||
{
|
||||
box_unsigned_4(float_bits(untag_float_check(dpop())));
|
||||
}
|
||||
|
||||
PRIMITIVE(bits_float)
|
||||
PRIMITIVE(float_bits)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_float_bits();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bits_float()
|
||||
{
|
||||
box_float(bits_float(to_cell(dpop())));
|
||||
}
|
||||
|
||||
PRIMITIVE(double_bits)
|
||||
PRIMITIVE(bits_float)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bits_float();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_double_bits()
|
||||
{
|
||||
box_unsigned_8(double_bits(untag_float_check(dpop())));
|
||||
}
|
||||
|
||||
PRIMITIVE(bits_double)
|
||||
PRIMITIVE(double_bits)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_double_bits();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_bits_double()
|
||||
{
|
||||
box_double(bits_double(to_unsigned_8(dpop())));
|
||||
}
|
||||
|
||||
VM_C_API fixnum to_fixnum(cell tagged)
|
||||
PRIMITIVE(bits_double)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_bits_double();
|
||||
}
|
||||
|
||||
fixnum factorvm::to_fixnum(cell tagged)
|
||||
{
|
||||
switch(TAG(tagged))
|
||||
{
|
||||
|
@ -392,52 +618,112 @@ VM_C_API fixnum to_fixnum(cell tagged)
|
|||
}
|
||||
}
|
||||
|
||||
VM_C_API cell to_cell(cell tagged)
|
||||
VM_C_API fixnum to_fixnum(cell tagged,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_fixnum(tagged);
|
||||
}
|
||||
|
||||
cell factorvm::to_cell(cell tagged)
|
||||
{
|
||||
return (cell)to_fixnum(tagged);
|
||||
}
|
||||
|
||||
VM_C_API void box_signed_1(s8 n)
|
||||
VM_C_API cell to_cell(cell tagged, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_cell(tagged);
|
||||
}
|
||||
|
||||
void factorvm::box_signed_1(s8 n)
|
||||
{
|
||||
dpush(tag_fixnum(n));
|
||||
}
|
||||
|
||||
VM_C_API void box_unsigned_1(u8 n)
|
||||
VM_C_API void box_signed_1(s8 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_1(n);
|
||||
}
|
||||
|
||||
void factorvm::box_unsigned_1(u8 n)
|
||||
{
|
||||
dpush(tag_fixnum(n));
|
||||
}
|
||||
|
||||
VM_C_API void box_signed_2(s16 n)
|
||||
VM_C_API void box_unsigned_1(u8 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_1(n);
|
||||
}
|
||||
|
||||
void factorvm::box_signed_2(s16 n)
|
||||
{
|
||||
dpush(tag_fixnum(n));
|
||||
}
|
||||
|
||||
VM_C_API void box_unsigned_2(u16 n)
|
||||
VM_C_API void box_signed_2(s16 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_2(n);
|
||||
}
|
||||
|
||||
void factorvm::box_unsigned_2(u16 n)
|
||||
{
|
||||
dpush(tag_fixnum(n));
|
||||
}
|
||||
|
||||
VM_C_API void box_signed_4(s32 n)
|
||||
VM_C_API void box_unsigned_2(u16 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_2(n);
|
||||
}
|
||||
|
||||
void factorvm::box_signed_4(s32 n)
|
||||
{
|
||||
dpush(allot_integer(n));
|
||||
}
|
||||
|
||||
VM_C_API void box_unsigned_4(u32 n)
|
||||
VM_C_API void box_signed_4(s32 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_4(n);
|
||||
}
|
||||
|
||||
void factorvm::box_unsigned_4(u32 n)
|
||||
{
|
||||
dpush(allot_cell(n));
|
||||
}
|
||||
|
||||
VM_C_API void box_signed_cell(fixnum integer)
|
||||
VM_C_API void box_unsigned_4(u32 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_4(n);
|
||||
}
|
||||
|
||||
void factorvm::box_signed_cell(fixnum integer)
|
||||
{
|
||||
dpush(allot_integer(integer));
|
||||
}
|
||||
|
||||
VM_C_API void box_unsigned_cell(cell cell)
|
||||
VM_C_API void box_signed_cell(fixnum integer,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_cell(integer);
|
||||
}
|
||||
|
||||
void factorvm::box_unsigned_cell(cell cell)
|
||||
{
|
||||
dpush(allot_cell(cell));
|
||||
}
|
||||
|
||||
VM_C_API void box_signed_8(s64 n)
|
||||
VM_C_API void box_unsigned_cell(cell cell,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_cell(cell);
|
||||
}
|
||||
|
||||
void factorvm::box_signed_8(s64 n)
|
||||
{
|
||||
if(n < fixnum_min || n > fixnum_max)
|
||||
dpush(tag<bignum>(long_long_to_bignum(n)));
|
||||
|
@ -445,7 +731,13 @@ VM_C_API void box_signed_8(s64 n)
|
|||
dpush(tag_fixnum(n));
|
||||
}
|
||||
|
||||
VM_C_API s64 to_signed_8(cell obj)
|
||||
VM_C_API void box_signed_8(s64 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_signed_8(n);
|
||||
}
|
||||
|
||||
s64 factorvm::to_signed_8(cell obj)
|
||||
{
|
||||
switch(tagged<object>(obj).type())
|
||||
{
|
||||
|
@ -459,7 +751,13 @@ VM_C_API s64 to_signed_8(cell obj)
|
|||
}
|
||||
}
|
||||
|
||||
VM_C_API void box_unsigned_8(u64 n)
|
||||
VM_C_API s64 to_signed_8(cell obj,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_signed_8(obj);
|
||||
}
|
||||
|
||||
void factorvm::box_unsigned_8(u64 n)
|
||||
{
|
||||
if(n > (u64)fixnum_max)
|
||||
dpush(tag<bignum>(ulong_long_to_bignum(n)));
|
||||
|
@ -467,7 +765,13 @@ VM_C_API void box_unsigned_8(u64 n)
|
|||
dpush(tag_fixnum(n));
|
||||
}
|
||||
|
||||
VM_C_API u64 to_unsigned_8(cell obj)
|
||||
VM_C_API void box_unsigned_8(u64 n,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_unsigned_8(n);
|
||||
}
|
||||
|
||||
u64 factorvm::to_unsigned_8(cell obj)
|
||||
{
|
||||
switch(tagged<object>(obj).type())
|
||||
{
|
||||
|
@ -481,47 +785,92 @@ VM_C_API u64 to_unsigned_8(cell obj)
|
|||
}
|
||||
}
|
||||
|
||||
VM_C_API void box_float(float flo)
|
||||
VM_C_API u64 to_unsigned_8(cell obj,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_unsigned_8(obj);
|
||||
}
|
||||
|
||||
void factorvm::box_float(float flo)
|
||||
{
|
||||
dpush(allot_float(flo));
|
||||
}
|
||||
|
||||
VM_C_API float to_float(cell value)
|
||||
VM_C_API void box_float(float flo,factorvm *myvm) // not sure if this is ever called
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_float(flo);
|
||||
}
|
||||
|
||||
float factorvm::to_float(cell value)
|
||||
{
|
||||
return untag_float_check(value);
|
||||
}
|
||||
|
||||
VM_C_API void box_double(double flo)
|
||||
VM_C_API float to_float(cell value,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_float(value);
|
||||
}
|
||||
|
||||
void factorvm::box_double(double flo)
|
||||
{
|
||||
dpush(allot_float(flo));
|
||||
}
|
||||
|
||||
VM_C_API double to_double(cell value)
|
||||
VM_C_API void box_double(double flo,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->box_double(flo);
|
||||
}
|
||||
|
||||
double factorvm::to_double(cell value)
|
||||
{
|
||||
return untag_float_check(value);
|
||||
}
|
||||
|
||||
VM_C_API double to_double(cell value,factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->to_double(value);
|
||||
}
|
||||
|
||||
/* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
|
||||
overflow, they call these functions. */
|
||||
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
|
||||
inline void factorvm::overflow_fixnum_add(fixnum x, fixnum y)
|
||||
{
|
||||
drepl(tag<bignum>(fixnum_to_bignum(
|
||||
untag_fixnum(x) + untag_fixnum(y))));
|
||||
}
|
||||
|
||||
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
|
||||
VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *myvm)
|
||||
{
|
||||
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
|
||||
}
|
||||
|
||||
inline void factorvm::overflow_fixnum_subtract(fixnum x, fixnum y)
|
||||
{
|
||||
drepl(tag<bignum>(fixnum_to_bignum(
|
||||
untag_fixnum(x) - untag_fixnum(y))));
|
||||
}
|
||||
|
||||
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
|
||||
VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *myvm)
|
||||
{
|
||||
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
|
||||
}
|
||||
|
||||
inline void factorvm::overflow_fixnum_multiply(fixnum x, fixnum y)
|
||||
{
|
||||
bignum *bx = fixnum_to_bignum(x);
|
||||
GC_BIGNUM(bx);
|
||||
GC_BIGNUM(bx,this);
|
||||
bignum *by = fixnum_to_bignum(y);
|
||||
GC_BIGNUM(by);
|
||||
GC_BIGNUM(by,this);
|
||||
drepl(tag<bignum>(bignum_multiply(bx,by)));
|
||||
}
|
||||
|
||||
VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *myvm)
|
||||
{
|
||||
PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
102
vm/math.hpp
102
vm/math.hpp
|
@ -1,14 +1,11 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
extern cell bignum_zero;
|
||||
extern cell bignum_pos_one;
|
||||
extern cell bignum_neg_one;
|
||||
|
||||
static const fixnum fixnum_max = (((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)) - 1);
|
||||
static const fixnum fixnum_min = (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)));
|
||||
static const fixnum array_size_max = ((cell)1 << (WORD_SIZE - TAG_BITS - 2));
|
||||
|
||||
// defined in assembler
|
||||
PRIMITIVE(fixnum_add);
|
||||
PRIMITIVE(fixnum_subtract);
|
||||
PRIMITIVE(fixnum_multiply);
|
||||
|
@ -42,61 +39,6 @@ PRIMITIVE(bignum_bitp);
|
|||
PRIMITIVE(bignum_log2);
|
||||
PRIMITIVE(byte_array_to_bignum);
|
||||
|
||||
inline static cell allot_integer(fixnum x)
|
||||
{
|
||||
if(x < fixnum_min || x > fixnum_max)
|
||||
return tag<bignum>(fixnum_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
inline static cell allot_cell(cell x)
|
||||
{
|
||||
if(x > (cell)fixnum_max)
|
||||
return tag<bignum>(cell_to_bignum(x));
|
||||
else
|
||||
return tag_fixnum(x);
|
||||
}
|
||||
|
||||
cell unbox_array_size();
|
||||
|
||||
inline static double untag_float(cell tagged)
|
||||
{
|
||||
return untag<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline static double untag_float_check(cell tagged)
|
||||
{
|
||||
return untag_check<boxed_float>(tagged)->n;
|
||||
}
|
||||
|
||||
inline static cell allot_float(double n)
|
||||
{
|
||||
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
|
||||
flo->n = n;
|
||||
return tag(flo);
|
||||
}
|
||||
|
||||
inline static fixnum float_to_fixnum(cell tagged)
|
||||
{
|
||||
return (fixnum)untag_float(tagged);
|
||||
}
|
||||
|
||||
inline static bignum *float_to_bignum(cell tagged)
|
||||
{
|
||||
return double_to_bignum(untag_float(tagged));
|
||||
}
|
||||
|
||||
inline static double fixnum_to_float(cell tagged)
|
||||
{
|
||||
return (double)untag_fixnum(tagged);
|
||||
}
|
||||
|
||||
inline static double bignum_to_float(cell tagged)
|
||||
{
|
||||
return bignum_to_double(untag<bignum>(tagged));
|
||||
}
|
||||
|
||||
PRIMITIVE(fixnum_to_float);
|
||||
PRIMITIVE(bignum_to_float);
|
||||
PRIMITIVE(str_to_float);
|
||||
|
@ -119,30 +61,30 @@ PRIMITIVE(bits_float);
|
|||
PRIMITIVE(double_bits);
|
||||
PRIMITIVE(bits_double);
|
||||
|
||||
VM_C_API void box_float(float flo);
|
||||
VM_C_API float to_float(cell value);
|
||||
VM_C_API void box_double(double flo);
|
||||
VM_C_API double to_double(cell value);
|
||||
VM_C_API void box_float(float flo, factorvm *vm);
|
||||
VM_C_API float to_float(cell value, factorvm *vm);
|
||||
VM_C_API void box_double(double flo, factorvm *vm);
|
||||
VM_C_API double to_double(cell value, factorvm *vm);
|
||||
|
||||
VM_C_API void box_signed_1(s8 n);
|
||||
VM_C_API void box_unsigned_1(u8 n);
|
||||
VM_C_API void box_signed_2(s16 n);
|
||||
VM_C_API void box_unsigned_2(u16 n);
|
||||
VM_C_API void box_signed_4(s32 n);
|
||||
VM_C_API void box_unsigned_4(u32 n);
|
||||
VM_C_API void box_signed_cell(fixnum integer);
|
||||
VM_C_API void box_unsigned_cell(cell cell);
|
||||
VM_C_API void box_signed_8(s64 n);
|
||||
VM_C_API void box_unsigned_8(u64 n);
|
||||
VM_C_API void box_signed_1(s8 n, factorvm *vm);
|
||||
VM_C_API void box_unsigned_1(u8 n, factorvm *vm);
|
||||
VM_C_API void box_signed_2(s16 n, factorvm *vm);
|
||||
VM_C_API void box_unsigned_2(u16 n, factorvm *vm);
|
||||
VM_C_API void box_signed_4(s32 n, factorvm *vm);
|
||||
VM_C_API void box_unsigned_4(u32 n, factorvm *vm);
|
||||
VM_C_API void box_signed_cell(fixnum integer, factorvm *vm);
|
||||
VM_C_API void box_unsigned_cell(cell cell, factorvm *vm);
|
||||
VM_C_API void box_signed_8(s64 n, factorvm *vm);
|
||||
VM_C_API void box_unsigned_8(u64 n, factorvm *vm);
|
||||
|
||||
VM_C_API s64 to_signed_8(cell obj);
|
||||
VM_C_API u64 to_unsigned_8(cell obj);
|
||||
VM_C_API s64 to_signed_8(cell obj, factorvm *vm);
|
||||
VM_C_API u64 to_unsigned_8(cell obj, factorvm *vm);
|
||||
|
||||
VM_C_API fixnum to_fixnum(cell tagged);
|
||||
VM_C_API cell to_cell(cell tagged);
|
||||
VM_C_API fixnum to_fixnum(cell tagged, factorvm *vm);
|
||||
VM_C_API cell to_cell(cell tagged, factorvm *vm);
|
||||
|
||||
VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y);
|
||||
VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y);
|
||||
VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y);
|
||||
VM_ASM_API_OVERFLOW void overflow_fixnum_add(fixnum x, fixnum y, factorvm *vm);
|
||||
VM_ASM_API_OVERFLOW void overflow_fixnum_subtract(fixnum x, fixnum y, factorvm *vm);
|
||||
VM_ASM_API_OVERFLOW void overflow_fixnum_multiply(fixnum x, fixnum y, factorvm *vm);
|
||||
|
||||
}
|
||||
|
|
|
@ -3,9 +3,9 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
void c_to_factor_toplevel(cell quot)
|
||||
void factorvm::c_to_factor_toplevel(cell quot)
|
||||
{
|
||||
c_to_factor(quot);
|
||||
c_to_factor(quot,this);
|
||||
}
|
||||
|
||||
void init_signals()
|
||||
|
|
|
@ -25,7 +25,7 @@ void flush_icache(cell start, cell len)
|
|||
: "r0","r1","r2");
|
||||
|
||||
if(result < 0)
|
||||
critical_error("flush_icache() failed",result);
|
||||
SIGNAL_VM_PTR->critical_error("flush_icache() failed",result);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -42,19 +42,19 @@ VM_C_API int inotify_rm_watch(int fd, u32 wd)
|
|||
|
||||
VM_C_API int inotify_init()
|
||||
{
|
||||
not_implemented_error();
|
||||
VM_PTR->not_implemented_error();
|
||||
return -1;
|
||||
}
|
||||
|
||||
VM_C_API int inotify_add_watch(int fd, const char *name, u32 mask)
|
||||
{
|
||||
not_implemented_error();
|
||||
VM_PTR->not_implemented_error();
|
||||
return -1;
|
||||
}
|
||||
|
||||
VM_C_API int inotify_rm_watch(int fd, u32 wd)
|
||||
{
|
||||
not_implemented_error();
|
||||
VM_PTR->not_implemented_error();
|
||||
return -1;
|
||||
}
|
||||
|
||||
|
|
|
@ -5,12 +5,12 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
void c_to_factor_toplevel(cell quot)
|
||||
void factorvm::c_to_factor_toplevel(cell quot)
|
||||
{
|
||||
for(;;)
|
||||
{
|
||||
NS_DURING
|
||||
c_to_factor(quot);
|
||||
c_to_factor(quot,this);
|
||||
NS_VOIDRETURN;
|
||||
NS_HANDLER
|
||||
dpush(allot_alien(F,(cell)localException));
|
||||
|
|
|
@ -3,18 +3,39 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
void start_thread(void *(*start_routine)(void *))
|
||||
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args)
|
||||
{
|
||||
pthread_attr_t attr;
|
||||
pthread_t thread;
|
||||
|
||||
if (pthread_attr_init (&attr) != 0)
|
||||
fatal_error("pthread_attr_init() failed",0);
|
||||
if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED) != 0)
|
||||
if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_JOINABLE) != 0)
|
||||
fatal_error("pthread_attr_setdetachstate() failed",0);
|
||||
if (pthread_create (&thread, &attr, start_routine, NULL) != 0)
|
||||
if (pthread_create (&thread, &attr, start_routine, args) != 0)
|
||||
fatal_error("pthread_create() failed",0);
|
||||
pthread_attr_destroy (&attr);
|
||||
return thread;
|
||||
}
|
||||
|
||||
|
||||
pthread_key_t tlsKey = 0;
|
||||
|
||||
void init_platform_globals()
|
||||
{
|
||||
if (pthread_key_create(&tlsKey, NULL) != 0){
|
||||
fatal_error("pthread_key_create() failed",0);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
void register_vm_with_thread(factorvm *vm)
|
||||
{
|
||||
pthread_setspecific(tlsKey,vm);
|
||||
}
|
||||
|
||||
factorvm *tls_vm()
|
||||
{
|
||||
return (factorvm*)pthread_getspecific(tlsKey);
|
||||
}
|
||||
|
||||
static void *null_dll;
|
||||
|
@ -31,38 +52,46 @@ void sleep_micros(cell usec)
|
|||
usleep(usec);
|
||||
}
|
||||
|
||||
void init_ffi()
|
||||
void factorvm::init_ffi()
|
||||
{
|
||||
/* NULL_DLL is "libfactor.dylib" for OS X and NULL for generic unix */
|
||||
null_dll = dlopen(NULL_DLL,RTLD_LAZY);
|
||||
}
|
||||
|
||||
void ffi_dlopen(dll *dll)
|
||||
void factorvm::ffi_dlopen(dll *dll)
|
||||
{
|
||||
dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY);
|
||||
}
|
||||
|
||||
void *ffi_dlsym(dll *dll, symbol_char *symbol)
|
||||
void *factorvm::ffi_dlsym(dll *dll, symbol_char *symbol)
|
||||
{
|
||||
void *handle = (dll == NULL ? null_dll : dll->dll);
|
||||
return dlsym(handle,symbol);
|
||||
}
|
||||
|
||||
void ffi_dlclose(dll *dll)
|
||||
void factorvm::ffi_dlclose(dll *dll)
|
||||
{
|
||||
if(dlclose(dll->dll))
|
||||
general_error(ERROR_FFI,F,F,NULL);
|
||||
dll->dll = NULL;
|
||||
}
|
||||
|
||||
PRIMITIVE(existsp)
|
||||
|
||||
|
||||
|
||||
inline void factorvm::vmprim_existsp()
|
||||
{
|
||||
struct stat sb;
|
||||
char *path = (char *)(untag_check<byte_array>(dpop()) + 1);
|
||||
box_boolean(stat(path,&sb) >= 0);
|
||||
}
|
||||
|
||||
segment *alloc_segment(cell size)
|
||||
PRIMITIVE(existsp)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_existsp();
|
||||
}
|
||||
|
||||
segment *factorvm::alloc_segment(cell size)
|
||||
{
|
||||
int pagesize = getpagesize();
|
||||
|
||||
|
@ -101,7 +130,7 @@ void dealloc_segment(segment *block)
|
|||
free(block);
|
||||
}
|
||||
|
||||
static stack_frame *uap_stack_pointer(void *uap)
|
||||
stack_frame *factorvm::uap_stack_pointer(void *uap)
|
||||
{
|
||||
/* There is a race condition here, but in practice a signal
|
||||
delivered during stack frame setup/teardown or while transitioning
|
||||
|
@ -118,30 +147,48 @@ static stack_frame *uap_stack_pointer(void *uap)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
|
||||
|
||||
void factorvm::memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
signal_fault_addr = (cell)siginfo->si_addr;
|
||||
signal_callstack_top = uap_stack_pointer(uap);
|
||||
UAP_PROGRAM_COUNTER(uap) = (cell)memory_signal_handler_impl;
|
||||
UAP_PROGRAM_COUNTER(uap) = (cell)factor::memory_signal_handler_impl;
|
||||
}
|
||||
|
||||
void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
SIGNAL_VM_PTR()->memory_signal_handler(signal,siginfo,uap);
|
||||
}
|
||||
|
||||
|
||||
void factorvm::misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
signal_number = signal;
|
||||
signal_callstack_top = uap_stack_pointer(uap);
|
||||
UAP_PROGRAM_COUNTER(uap) = (cell)factor::misc_signal_handler_impl;
|
||||
}
|
||||
|
||||
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
SIGNAL_VM_PTR()->misc_signal_handler(signal,siginfo,uap);
|
||||
}
|
||||
|
||||
void factorvm::fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
signal_number = signal;
|
||||
signal_callstack_top = uap_stack_pointer(uap);
|
||||
UAP_PROGRAM_COUNTER(uap) = (cell)misc_signal_handler_impl;
|
||||
signal_fpu_status = fpu_status(uap_fpu_status(uap));
|
||||
uap_clear_fpu_status(uap);
|
||||
UAP_PROGRAM_COUNTER(uap) =
|
||||
(siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF)
|
||||
? (cell)factor::misc_signal_handler_impl
|
||||
: (cell)factor::fp_signal_handler_impl;
|
||||
}
|
||||
|
||||
void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
|
||||
{
|
||||
signal_number = signal;
|
||||
signal_callstack_top = uap_stack_pointer(uap);
|
||||
signal_fpu_status = fpu_status(uap_fpu_status(uap));
|
||||
uap_clear_fpu_status(uap);
|
||||
UAP_PROGRAM_COUNTER(uap) =
|
||||
(siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF)
|
||||
? (cell)misc_signal_handler_impl
|
||||
: (cell)fp_signal_handler_impl;
|
||||
SIGNAL_VM_PTR()->fpe_signal_handler(signal, siginfo, uap);
|
||||
}
|
||||
|
||||
static void sigaction_safe(int signum, const struct sigaction *act, struct sigaction *oldact)
|
||||
|
@ -320,7 +367,7 @@ void open_console()
|
|||
stdin_read = filedes[0];
|
||||
stdin_write = filedes[1];
|
||||
|
||||
start_thread(stdin_loop);
|
||||
start_thread(stdin_loop,NULL);
|
||||
}
|
||||
|
||||
VM_C_API void wait_for_stdin()
|
||||
|
|
|
@ -42,12 +42,10 @@ typedef char symbol_char;
|
|||
|
||||
#define print_native_string(string) print_string(string)
|
||||
|
||||
void start_thread(void *(*start_routine)(void *));
|
||||
typedef pthread_t THREADHANDLE;
|
||||
|
||||
void init_ffi();
|
||||
void ffi_dlopen(dll *dll);
|
||||
void *ffi_dlsym(dll *dll, symbol_char *symbol);
|
||||
void ffi_dlclose(dll *dll);
|
||||
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
|
||||
pthread_t thread_id();
|
||||
|
||||
void unix_init_signals();
|
||||
void signal_handler(int signal, siginfo_t* siginfo, void* uap);
|
||||
|
@ -56,6 +54,9 @@ void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap);
|
|||
s64 current_micros();
|
||||
void sleep_micros(cell usec);
|
||||
|
||||
void init_platform_globals();
|
||||
struct factorvm;
|
||||
void register_vm_with_thread(factorvm *vm);
|
||||
factorvm *tls_vm();
|
||||
void open_console();
|
||||
|
||||
}
|
||||
|
|
|
@ -26,18 +26,18 @@ void flush_icache(cell start, cell end)
|
|||
|
||||
char *getenv(char *name)
|
||||
{
|
||||
not_implemented_error();
|
||||
vm->not_implemented_error();
|
||||
return 0; /* unreachable */
|
||||
}
|
||||
|
||||
PRIMITIVE(os_envs)
|
||||
{
|
||||
not_implemented_error();
|
||||
vm->not_implemented_error();
|
||||
}
|
||||
|
||||
void c_to_factor_toplevel(cell quot)
|
||||
{
|
||||
c_to_factor(quot);
|
||||
c_to_factor(quot,vm);
|
||||
}
|
||||
|
||||
void open_console() { }
|
||||
|
|
|
@ -3,6 +3,34 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
|
||||
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args){
|
||||
return (void*) CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
|
||||
}
|
||||
|
||||
|
||||
DWORD dwTlsIndex;
|
||||
|
||||
void init_platform_globals()
|
||||
{
|
||||
if ((dwTlsIndex = TlsAlloc()) == TLS_OUT_OF_INDEXES) {
|
||||
fatal_error("TlsAlloc failed - out of indexes",0);
|
||||
}
|
||||
}
|
||||
|
||||
void register_vm_with_thread(factorvm *vm)
|
||||
{
|
||||
if (! TlsSetValue(dwTlsIndex, vm)) {
|
||||
fatal_error("TlsSetValue failed",0);
|
||||
}
|
||||
}
|
||||
|
||||
factorvm *tls_vm()
|
||||
{
|
||||
return (factorvm*)TlsGetValue(dwTlsIndex);
|
||||
}
|
||||
|
||||
|
||||
s64 current_micros()
|
||||
{
|
||||
FILETIME t;
|
||||
|
@ -11,7 +39,7 @@ s64 current_micros()
|
|||
- EPOCH_OFFSET) / 10;
|
||||
}
|
||||
|
||||
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
|
||||
LONG factorvm::exception_handler(PEXCEPTION_POINTERS pe)
|
||||
{
|
||||
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
|
||||
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
|
||||
|
@ -21,11 +49,10 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
|
|||
else
|
||||
signal_callstack_top = NULL;
|
||||
|
||||
switch (e->ExceptionCode)
|
||||
{
|
||||
case EXCEPTION_ACCESS_VIOLATION:
|
||||
switch (e->ExceptionCode) {
|
||||
case EXCEPTION_ACCESS_VIOLATION:
|
||||
signal_fault_addr = e->ExceptionInformation[1];
|
||||
c->EIP = (cell)memory_signal_handler_impl;
|
||||
c->EIP = (cell)factor::memory_signal_handler_impl;
|
||||
break;
|
||||
|
||||
case STATUS_FLOAT_DENORMAL_OPERAND:
|
||||
|
@ -40,7 +67,7 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
|
|||
signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));
|
||||
X87SW(c) = 0;
|
||||
MXCSR(c) &= 0xffffffc0;
|
||||
c->EIP = (cell)fp_signal_handler_impl;
|
||||
c->EIP = (cell)factor::fp_signal_handler_impl;
|
||||
break;
|
||||
case 0x40010006:
|
||||
/* If the Widcomm bluetooth stack is installed, the BTTray.exe
|
||||
|
@ -52,21 +79,32 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
|
|||
break;
|
||||
default:
|
||||
signal_number = e->ExceptionCode;
|
||||
c->EIP = (cell)misc_signal_handler_impl;
|
||||
c->EIP = (cell)factor::misc_signal_handler_impl;
|
||||
break;
|
||||
}
|
||||
return EXCEPTION_CONTINUE_EXECUTION;
|
||||
}
|
||||
|
||||
void c_to_factor_toplevel(cell quot)
|
||||
|
||||
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
|
||||
{
|
||||
if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
|
||||
fatal_error("AddVectoredExceptionHandler failed", 0);
|
||||
c_to_factor(quot);
|
||||
RemoveVectoredExceptionHandler((void *)exception_handler);
|
||||
return SIGNAL_VM_PTR()->exception_handler(pe);
|
||||
}
|
||||
|
||||
void open_console()
|
||||
bool handler_added = 0;
|
||||
|
||||
void factorvm::c_to_factor_toplevel(cell quot)
|
||||
{
|
||||
if(!handler_added){
|
||||
if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)factor::exception_handler))
|
||||
fatal_error("AddVectoredExceptionHandler failed", 0);
|
||||
handler_added = 1;
|
||||
}
|
||||
c_to_factor(quot,this);
|
||||
RemoveVectoredExceptionHandler((void *)factor::exception_handler);
|
||||
}
|
||||
|
||||
void factorvm::open_console()
|
||||
{
|
||||
}
|
||||
|
||||
|
|
|
@ -19,13 +19,20 @@ typedef char symbol_char;
|
|||
|
||||
#define FACTOR_STDCALL __attribute__((stdcall))
|
||||
|
||||
void c_to_factor_toplevel(cell quot);
|
||||
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
|
||||
void open_console();
|
||||
|
||||
// SSE traps raise these exception codes, which are defined in internal NT headers
|
||||
// but not winbase.h
|
||||
#define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4
|
||||
#define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5
|
||||
|
||||
typedef HANDLE THREADHANDLE;
|
||||
|
||||
THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
|
||||
|
||||
void init_platform_globals();
|
||||
struct factorvm;
|
||||
void register_vm_with_thread(factorvm *vm);
|
||||
factorvm *tls_vm();
|
||||
|
||||
}
|
||||
|
|
|
@ -5,30 +5,30 @@ namespace factor
|
|||
|
||||
HMODULE hFactorDll;
|
||||
|
||||
void init_ffi()
|
||||
void factorvm::init_ffi()
|
||||
{
|
||||
hFactorDll = GetModuleHandle(FACTOR_DLL);
|
||||
if(!hFactorDll)
|
||||
fatal_error("GetModuleHandle(\"" FACTOR_DLL_NAME "\") failed", 0);
|
||||
}
|
||||
|
||||
void ffi_dlopen(dll *dll)
|
||||
void factorvm::ffi_dlopen(dll *dll)
|
||||
{
|
||||
dll->dll = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0);
|
||||
}
|
||||
|
||||
void *ffi_dlsym(dll *dll, symbol_char *symbol)
|
||||
void *factorvm::ffi_dlsym(dll *dll, symbol_char *symbol)
|
||||
{
|
||||
return (void *)GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol);
|
||||
}
|
||||
|
||||
void ffi_dlclose(dll *dll)
|
||||
void factorvm::ffi_dlclose(dll *dll)
|
||||
{
|
||||
FreeLibrary((HMODULE)dll->dll);
|
||||
dll->dll = NULL;
|
||||
}
|
||||
|
||||
bool windows_stat(vm_char *path)
|
||||
bool factorvm::windows_stat(vm_char *path)
|
||||
{
|
||||
BY_HANDLE_FILE_INFORMATION bhfi;
|
||||
HANDLE h = CreateFileW(path,
|
||||
|
@ -56,14 +56,15 @@ bool windows_stat(vm_char *path)
|
|||
return ret;
|
||||
}
|
||||
|
||||
void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length)
|
||||
|
||||
void factorvm::windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length)
|
||||
{
|
||||
snwprintf(temp_path, length-1, L"%s.image", full_path);
|
||||
temp_path[sizeof(temp_path) - 1] = 0;
|
||||
temp_path[length - 1] = 0;
|
||||
}
|
||||
|
||||
/* You must free() this yourself. */
|
||||
const vm_char *default_image_path()
|
||||
const vm_char *factorvm::default_image_path()
|
||||
{
|
||||
vm_char full_path[MAX_UNICODE_PATH];
|
||||
vm_char *ptr;
|
||||
|
@ -75,14 +76,14 @@ const vm_char *default_image_path()
|
|||
if((ptr = wcsrchr(full_path, '.')))
|
||||
*ptr = 0;
|
||||
|
||||
snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
|
||||
temp_path[sizeof(temp_path) - 1] = 0;
|
||||
snwprintf(temp_path, MAX_UNICODE_PATH-1, L"%s.image", full_path);
|
||||
temp_path[MAX_UNICODE_PATH - 1] = 0;
|
||||
|
||||
return safe_strdup(temp_path);
|
||||
}
|
||||
|
||||
/* You must free() this yourself. */
|
||||
const vm_char *vm_executable_path()
|
||||
const vm_char *factorvm::vm_executable_path()
|
||||
{
|
||||
vm_char full_path[MAX_UNICODE_PATH];
|
||||
if(!GetModuleFileName(NULL, full_path, MAX_UNICODE_PATH))
|
||||
|
@ -91,13 +92,18 @@ const vm_char *vm_executable_path()
|
|||
}
|
||||
|
||||
|
||||
PRIMITIVE(existsp)
|
||||
inline void factorvm::vmprim_existsp()
|
||||
{
|
||||
vm_char *path = untag_check<byte_array>(dpop())->data<vm_char>();
|
||||
box_boolean(windows_stat(path));
|
||||
}
|
||||
|
||||
segment *alloc_segment(cell size)
|
||||
PRIMITIVE(existsp)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_existsp();
|
||||
}
|
||||
|
||||
segment *factorvm::alloc_segment(cell size)
|
||||
{
|
||||
char *mem;
|
||||
DWORD ignore;
|
||||
|
@ -122,7 +128,7 @@ segment *alloc_segment(cell size)
|
|||
return block;
|
||||
}
|
||||
|
||||
void dealloc_segment(segment *block)
|
||||
void factorvm::dealloc_segment(segment *block)
|
||||
{
|
||||
SYSTEM_INFO si;
|
||||
GetSystemInfo(&si);
|
||||
|
@ -131,7 +137,7 @@ void dealloc_segment(segment *block)
|
|||
free(block);
|
||||
}
|
||||
|
||||
long getpagesize()
|
||||
long factorvm::getpagesize()
|
||||
{
|
||||
static long g_pagesize = 0;
|
||||
if (! g_pagesize)
|
||||
|
@ -143,7 +149,7 @@ long getpagesize()
|
|||
return g_pagesize;
|
||||
}
|
||||
|
||||
void sleep_micros(u64 usec)
|
||||
void factorvm::sleep_micros(u64 usec)
|
||||
{
|
||||
Sleep((DWORD)(usec / 1000));
|
||||
}
|
||||
|
|
|
@ -41,18 +41,9 @@ typedef wchar_t vm_char;
|
|||
/* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */
|
||||
#define EPOCH_OFFSET 0x019db1ded53e8000LL
|
||||
|
||||
void init_ffi();
|
||||
void ffi_dlopen(dll *dll);
|
||||
void *ffi_dlsym(dll *dll, symbol_char *symbol);
|
||||
void ffi_dlclose(dll *dll);
|
||||
|
||||
void sleep_micros(u64 msec);
|
||||
|
||||
inline static void init_signals() {}
|
||||
inline static void early_init() {}
|
||||
const vm_char *vm_executable_path();
|
||||
const vm_char *default_image_path();
|
||||
long getpagesize ();
|
||||
|
||||
s64 current_micros();
|
||||
|
||||
|
|
|
@ -162,6 +162,7 @@ const primitive_type primitives[] = {
|
|||
primitive_inline_cache_stats,
|
||||
primitive_optimized_p,
|
||||
primitive_quot_compiled_p,
|
||||
primitive_vm_ptr,
|
||||
};
|
||||
|
||||
}
|
||||
|
|
|
@ -1,9 +1,13 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
extern "C" typedef void (*primitive_type)();
|
||||
#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)
|
||||
#else
|
||||
extern "C" typedef void (*primitive_type)(void *myvm);
|
||||
#define PRIMITIVE(name) extern "C" void primitive_##name(void *myvm)
|
||||
#endif
|
||||
|
||||
extern const primitive_type primitives[];
|
||||
|
||||
#define PRIMITIVE(name) extern "C" void primitive_##name()
|
||||
|
||||
}
|
||||
|
|
|
@ -3,26 +3,27 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
bool profiling_p;
|
||||
|
||||
void init_profiler()
|
||||
void factorvm::init_profiler()
|
||||
{
|
||||
profiling_p = false;
|
||||
}
|
||||
|
||||
/* Allocates memory */
|
||||
code_block *compile_profiling_stub(cell word_)
|
||||
{
|
||||
gc_root<word> word(word_);
|
||||
|
||||
jit jit(WORD_TYPE,word.value());
|
||||
/* Allocates memory */
|
||||
code_block *factorvm::compile_profiling_stub(cell word_)
|
||||
{
|
||||
gc_root<word> word(word_,this);
|
||||
|
||||
jit jit(WORD_TYPE,word.value(),this);
|
||||
jit.emit_with(userenv[JIT_PROFILING],word.value());
|
||||
|
||||
return jit.to_code_block();
|
||||
}
|
||||
|
||||
|
||||
/* Allocates memory */
|
||||
static void set_profiling(bool profiling)
|
||||
void factorvm::set_profiling(bool profiling)
|
||||
{
|
||||
if(profiling == profiling_p)
|
||||
return;
|
||||
|
@ -33,7 +34,7 @@ static void set_profiling(bool profiling)
|
|||
and allocate profiling blocks if necessary */
|
||||
gc();
|
||||
|
||||
gc_root<array> words(find_all_words());
|
||||
gc_root<array> words(find_all_words(),this);
|
||||
|
||||
cell i;
|
||||
cell length = array_capacity(words.untagged());
|
||||
|
@ -46,12 +47,18 @@ static void set_profiling(bool profiling)
|
|||
}
|
||||
|
||||
/* Update XTs in code heap */
|
||||
iterate_code_heap(relocate_code_block);
|
||||
iterate_code_heap(factor::relocate_code_block);
|
||||
}
|
||||
|
||||
PRIMITIVE(profiling)
|
||||
|
||||
inline void factorvm::vmprim_profiling()
|
||||
{
|
||||
set_profiling(to_boolean(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE(profiling)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_profiling();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -1,9 +1,6 @@
|
|||
namespace factor
|
||||
{
|
||||
|
||||
extern bool profiling_p;
|
||||
void init_profiler();
|
||||
code_block *compile_profiling_stub(cell word);
|
||||
PRIMITIVE(profiling);
|
||||
|
||||
}
|
||||
|
|
|
@ -40,7 +40,7 @@ bool quotation_jit::primitive_call_p(cell i)
|
|||
{
|
||||
return (i + 2) == array_capacity(elements.untagged())
|
||||
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(FIXNUM_TYPE)
|
||||
&& array_nth(elements.untagged(),i + 1) == userenv[JIT_PRIMITIVE_WORD];
|
||||
&& array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_PRIMITIVE_WORD];
|
||||
}
|
||||
|
||||
bool quotation_jit::fast_if_p(cell i)
|
||||
|
@ -48,28 +48,28 @@ bool quotation_jit::fast_if_p(cell i)
|
|||
return (i + 3) == array_capacity(elements.untagged())
|
||||
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
|
||||
&& tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(QUOTATION_TYPE)
|
||||
&& array_nth(elements.untagged(),i + 2) == userenv[JIT_IF_WORD];
|
||||
&& array_nth(elements.untagged(),i + 2) == myvm->userenv[JIT_IF_WORD];
|
||||
}
|
||||
|
||||
bool quotation_jit::fast_dip_p(cell i)
|
||||
{
|
||||
return (i + 2) <= array_capacity(elements.untagged())
|
||||
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
|
||||
&& array_nth(elements.untagged(),i + 1) == userenv[JIT_DIP_WORD];
|
||||
&& array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_DIP_WORD];
|
||||
}
|
||||
|
||||
bool quotation_jit::fast_2dip_p(cell i)
|
||||
{
|
||||
return (i + 2) <= array_capacity(elements.untagged())
|
||||
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
|
||||
&& array_nth(elements.untagged(),i + 1) == userenv[JIT_2DIP_WORD];
|
||||
&& array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_2DIP_WORD];
|
||||
}
|
||||
|
||||
bool quotation_jit::fast_3dip_p(cell i)
|
||||
{
|
||||
return (i + 2) <= array_capacity(elements.untagged())
|
||||
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
|
||||
&& array_nth(elements.untagged(),i + 1) == userenv[JIT_3DIP_WORD];
|
||||
&& array_nth(elements.untagged(),i + 1) == myvm->userenv[JIT_3DIP_WORD];
|
||||
}
|
||||
|
||||
bool quotation_jit::mega_lookup_p(cell i)
|
||||
|
@ -78,7 +78,7 @@ bool quotation_jit::mega_lookup_p(cell i)
|
|||
&& tagged<object>(array_nth(elements.untagged(),i)).type_p(ARRAY_TYPE)
|
||||
&& tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(FIXNUM_TYPE)
|
||||
&& tagged<object>(array_nth(elements.untagged(),i + 2)).type_p(ARRAY_TYPE)
|
||||
&& array_nth(elements.untagged(),i + 3) == userenv[MEGA_LOOKUP_WORD];
|
||||
&& array_nth(elements.untagged(),i + 3) == myvm->userenv[MEGA_LOOKUP_WORD];
|
||||
}
|
||||
|
||||
bool quotation_jit::stack_frame_p()
|
||||
|
@ -92,7 +92,7 @@ bool quotation_jit::stack_frame_p()
|
|||
switch(tagged<object>(obj).type())
|
||||
{
|
||||
case WORD_TYPE:
|
||||
if(untag<word>(obj)->subprimitive == F)
|
||||
if(myvm->untag<word>(obj)->subprimitive == F)
|
||||
return true;
|
||||
break;
|
||||
case QUOTATION_TYPE:
|
||||
|
@ -115,7 +115,7 @@ void quotation_jit::iterate_quotation()
|
|||
set_position(0);
|
||||
|
||||
if(stack_frame)
|
||||
emit(userenv[JIT_PROLOG]);
|
||||
emit(myvm->userenv[JIT_PROLOG]);
|
||||
|
||||
cell i;
|
||||
cell length = array_capacity(elements.untagged());
|
||||
|
@ -125,7 +125,7 @@ void quotation_jit::iterate_quotation()
|
|||
{
|
||||
set_position(i);
|
||||
|
||||
gc_root<object> obj(array_nth(elements.untagged(),i));
|
||||
gc_root<object> obj(array_nth(elements.untagged(),i),myvm);
|
||||
|
||||
switch(obj.type())
|
||||
{
|
||||
|
@ -134,23 +134,23 @@ void quotation_jit::iterate_quotation()
|
|||
if(obj.as<word>()->subprimitive != F)
|
||||
emit_subprimitive(obj.value());
|
||||
/* The (execute) primitive is special-cased */
|
||||
else if(obj.value() == userenv[JIT_EXECUTE_WORD])
|
||||
else if(obj.value() == myvm->userenv[JIT_EXECUTE_WORD])
|
||||
{
|
||||
if(i == length - 1)
|
||||
{
|
||||
if(stack_frame) emit(userenv[JIT_EPILOG]);
|
||||
if(stack_frame) emit(myvm->userenv[JIT_EPILOG]);
|
||||
tail_call = true;
|
||||
emit(userenv[JIT_EXECUTE_JUMP]);
|
||||
emit(myvm->userenv[JIT_EXECUTE_JUMP]);
|
||||
}
|
||||
else
|
||||
emit(userenv[JIT_EXECUTE_CALL]);
|
||||
emit(myvm->userenv[JIT_EXECUTE_CALL]);
|
||||
}
|
||||
/* Everything else */
|
||||
else
|
||||
{
|
||||
if(i == length - 1)
|
||||
{
|
||||
if(stack_frame) emit(userenv[JIT_EPILOG]);
|
||||
if(stack_frame) emit(myvm->userenv[JIT_EPILOG]);
|
||||
tail_call = true;
|
||||
/* Inline cache misses are special-cased.
|
||||
The calling convention for tail
|
||||
|
@ -160,8 +160,8 @@ void quotation_jit::iterate_quotation()
|
|||
the inline cache miss primitive, and
|
||||
we don't want to clobber the saved
|
||||
address. */
|
||||
if(obj.value() == userenv[PIC_MISS_WORD]
|
||||
|| obj.value() == userenv[PIC_MISS_TAIL_WORD])
|
||||
if(obj.value() == myvm->userenv[PIC_MISS_WORD]
|
||||
|| obj.value() == myvm->userenv[PIC_MISS_TAIL_WORD])
|
||||
{
|
||||
word_special(obj.value());
|
||||
}
|
||||
|
@ -181,7 +181,7 @@ void quotation_jit::iterate_quotation()
|
|||
/* Primitive calls */
|
||||
if(primitive_call_p(i))
|
||||
{
|
||||
emit_with(userenv[JIT_PRIMITIVE],obj.value());
|
||||
emit_with(myvm->userenv[JIT_PRIMITIVE],obj.value());
|
||||
|
||||
i++;
|
||||
|
||||
|
@ -193,18 +193,18 @@ void quotation_jit::iterate_quotation()
|
|||
mutually recursive in the library, but both still work) */
|
||||
if(fast_if_p(i))
|
||||
{
|
||||
if(stack_frame) emit(userenv[JIT_EPILOG]);
|
||||
if(stack_frame) emit(myvm->userenv[JIT_EPILOG]);
|
||||
tail_call = true;
|
||||
|
||||
if(compiling)
|
||||
{
|
||||
jit_compile(array_nth(elements.untagged(),i),relocate);
|
||||
jit_compile(array_nth(elements.untagged(),i + 1),relocate);
|
||||
myvm->jit_compile(array_nth(elements.untagged(),i),relocate);
|
||||
myvm->jit_compile(array_nth(elements.untagged(),i + 1),relocate);
|
||||
}
|
||||
|
||||
literal(array_nth(elements.untagged(),i));
|
||||
literal(array_nth(elements.untagged(),i + 1));
|
||||
emit(userenv[JIT_IF]);
|
||||
emit(myvm->userenv[JIT_IF]);
|
||||
|
||||
i += 2;
|
||||
|
||||
|
@ -214,8 +214,8 @@ void quotation_jit::iterate_quotation()
|
|||
else if(fast_dip_p(i))
|
||||
{
|
||||
if(compiling)
|
||||
jit_compile(obj.value(),relocate);
|
||||
emit_with(userenv[JIT_DIP],obj.value());
|
||||
myvm->jit_compile(obj.value(),relocate);
|
||||
emit_with(myvm->userenv[JIT_DIP],obj.value());
|
||||
i++;
|
||||
break;
|
||||
}
|
||||
|
@ -223,8 +223,8 @@ void quotation_jit::iterate_quotation()
|
|||
else if(fast_2dip_p(i))
|
||||
{
|
||||
if(compiling)
|
||||
jit_compile(obj.value(),relocate);
|
||||
emit_with(userenv[JIT_2DIP],obj.value());
|
||||
myvm->jit_compile(obj.value(),relocate);
|
||||
emit_with(myvm->userenv[JIT_2DIP],obj.value());
|
||||
i++;
|
||||
break;
|
||||
}
|
||||
|
@ -232,8 +232,8 @@ void quotation_jit::iterate_quotation()
|
|||
else if(fast_3dip_p(i))
|
||||
{
|
||||
if(compiling)
|
||||
jit_compile(obj.value(),relocate);
|
||||
emit_with(userenv[JIT_3DIP],obj.value());
|
||||
myvm->jit_compile(obj.value(),relocate);
|
||||
emit_with(myvm->userenv[JIT_3DIP],obj.value());
|
||||
i++;
|
||||
break;
|
||||
}
|
||||
|
@ -260,12 +260,12 @@ void quotation_jit::iterate_quotation()
|
|||
set_position(length);
|
||||
|
||||
if(stack_frame)
|
||||
emit(userenv[JIT_EPILOG]);
|
||||
emit(userenv[JIT_RETURN]);
|
||||
emit(myvm->userenv[JIT_EPILOG]);
|
||||
emit(myvm->userenv[JIT_RETURN]);
|
||||
}
|
||||
}
|
||||
|
||||
void set_quot_xt(quotation *quot, code_block *code)
|
||||
void factorvm::set_quot_xt(quotation *quot, code_block *code)
|
||||
{
|
||||
if(code->type != QUOTATION_TYPE)
|
||||
critical_error("Bad param to set_quot_xt",(cell)code);
|
||||
|
@ -275,12 +275,12 @@ void set_quot_xt(quotation *quot, code_block *code)
|
|||
}
|
||||
|
||||
/* Allocates memory */
|
||||
void jit_compile(cell quot_, bool relocating)
|
||||
void factorvm::jit_compile(cell quot_, bool relocating)
|
||||
{
|
||||
gc_root<quotation> quot(quot_);
|
||||
gc_root<quotation> quot(quot_,this);
|
||||
if(quot->code) return;
|
||||
|
||||
quotation_jit compiler(quot.value(),true,relocating);
|
||||
quotation_jit compiler(quot.value(),true,relocating,this);
|
||||
compiler.iterate_quotation();
|
||||
|
||||
code_block *compiled = compiler.to_code_block();
|
||||
|
@ -289,13 +289,18 @@ void jit_compile(cell quot_, bool relocating)
|
|||
if(relocating) relocate_code_block(compiled);
|
||||
}
|
||||
|
||||
PRIMITIVE(jit_compile)
|
||||
inline void factorvm::vmprim_jit_compile()
|
||||
{
|
||||
jit_compile(dpop(),true);
|
||||
}
|
||||
|
||||
PRIMITIVE(jit_compile)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_jit_compile();
|
||||
}
|
||||
|
||||
/* push a new quotation on the stack */
|
||||
PRIMITIVE(array_to_quotation)
|
||||
inline void factorvm::vmprim_array_to_quotation()
|
||||
{
|
||||
quotation *quot = allot<quotation>(sizeof(quotation));
|
||||
quot->array = dpeek();
|
||||
|
@ -306,21 +311,31 @@ PRIMITIVE(array_to_quotation)
|
|||
drepl(tag<quotation>(quot));
|
||||
}
|
||||
|
||||
PRIMITIVE(quotation_xt)
|
||||
PRIMITIVE(array_to_quotation)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_array_to_quotation();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_quotation_xt()
|
||||
{
|
||||
quotation *quot = untag_check<quotation>(dpeek());
|
||||
drepl(allot_cell((cell)quot->xt));
|
||||
}
|
||||
|
||||
void compile_all_words()
|
||||
PRIMITIVE(quotation_xt)
|
||||
{
|
||||
gc_root<array> words(find_all_words());
|
||||
PRIMITIVE_GETVM()->vmprim_quotation_xt();
|
||||
}
|
||||
|
||||
void factorvm::compile_all_words()
|
||||
{
|
||||
gc_root<array> words(find_all_words(),this);
|
||||
|
||||
cell i;
|
||||
cell length = array_capacity(words.untagged());
|
||||
for(i = 0; i < length; i++)
|
||||
{
|
||||
gc_root<word> word(array_nth(words.untagged(),i));
|
||||
gc_root<word> word(array_nth(words.untagged(),i),this);
|
||||
|
||||
if(!word->code || !word_optimized_p(word.untagged()))
|
||||
jit_compile_word(word.value(),word->def,false);
|
||||
|
@ -329,35 +344,46 @@ void compile_all_words()
|
|||
|
||||
}
|
||||
|
||||
iterate_code_heap(relocate_code_block);
|
||||
iterate_code_heap(factor::relocate_code_block);
|
||||
}
|
||||
|
||||
/* Allocates memory */
|
||||
fixnum quot_code_offset_to_scan(cell quot_, cell offset)
|
||||
fixnum factorvm::quot_code_offset_to_scan(cell quot_, cell offset)
|
||||
{
|
||||
gc_root<quotation> quot(quot_);
|
||||
gc_root<array> array(quot->array);
|
||||
gc_root<quotation> quot(quot_,this);
|
||||
gc_root<array> array(quot->array,this);
|
||||
|
||||
quotation_jit compiler(quot.value(),false,false);
|
||||
quotation_jit compiler(quot.value(),false,false,this);
|
||||
compiler.compute_position(offset);
|
||||
compiler.iterate_quotation();
|
||||
|
||||
return compiler.get_position();
|
||||
}
|
||||
|
||||
VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack)
|
||||
cell factorvm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
|
||||
{
|
||||
gc_root<quotation> quot(quot_);
|
||||
gc_root<quotation> quot(quot_,this);
|
||||
stack_chain->callstack_top = stack;
|
||||
jit_compile(quot.value(),true);
|
||||
return quot.value();
|
||||
}
|
||||
|
||||
PRIMITIVE(quot_compiled_p)
|
||||
VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factorvm *myvm)
|
||||
{
|
||||
ASSERTVM();
|
||||
return VM_PTR->lazy_jit_compile_impl(quot_,stack);
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_quot_compiled_p()
|
||||
{
|
||||
tagged<quotation> quot(dpop());
|
||||
quot.untag_check();
|
||||
quot.untag_check(this);
|
||||
dpush(tag_boolean(quot->code != NULL));
|
||||
}
|
||||
|
||||
PRIMITIVE(quot_compiled_p)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_quot_compiled_p();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -5,11 +5,11 @@ struct quotation_jit : public jit {
|
|||
gc_root<array> elements;
|
||||
bool compiling, relocate;
|
||||
|
||||
quotation_jit(cell quot, bool compiling_, bool relocate_)
|
||||
: jit(QUOTATION_TYPE,quot),
|
||||
elements(owner.as<quotation>().untagged()->array),
|
||||
quotation_jit(cell quot, bool compiling_, bool relocate_, factorvm *vm)
|
||||
: jit(QUOTATION_TYPE,quot,vm),
|
||||
elements(owner.as<quotation>().untagged()->array,vm),
|
||||
compiling(compiling_),
|
||||
relocate(relocate_) {};
|
||||
relocate(relocate_){};
|
||||
|
||||
void emit_mega_cache_lookup(cell methods, fixnum index, cell cache);
|
||||
bool primitive_call_p(cell i);
|
||||
|
@ -22,18 +22,12 @@ struct quotation_jit : public jit {
|
|||
void iterate_quotation();
|
||||
};
|
||||
|
||||
void set_quot_xt(quotation *quot, code_block *code);
|
||||
void jit_compile(cell quot, bool relocate);
|
||||
fixnum quot_code_offset_to_scan(cell quot, cell offset);
|
||||
|
||||
PRIMITIVE(jit_compile);
|
||||
|
||||
void compile_all_words();
|
||||
|
||||
PRIMITIVE(array_to_quotation);
|
||||
PRIMITIVE(quotation_xt);
|
||||
|
||||
VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack);
|
||||
VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factorvm *myvm);
|
||||
|
||||
PRIMITIVE(quot_compiled_p);
|
||||
|
||||
|
|
|
@ -1,41 +1,63 @@
|
|||
#include "master.hpp"
|
||||
|
||||
factor::cell userenv[USER_ENV];
|
||||
|
||||
namespace factor
|
||||
{
|
||||
|
||||
cell T;
|
||||
|
||||
PRIMITIVE(getenv)
|
||||
inline void factorvm::vmprim_getenv()
|
||||
{
|
||||
fixnum e = untag_fixnum(dpeek());
|
||||
drepl(userenv[e]);
|
||||
}
|
||||
|
||||
PRIMITIVE(setenv)
|
||||
PRIMITIVE(getenv)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_getenv();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_setenv()
|
||||
{
|
||||
fixnum e = untag_fixnum(dpop());
|
||||
cell value = dpop();
|
||||
userenv[e] = value;
|
||||
}
|
||||
|
||||
PRIMITIVE(exit)
|
||||
PRIMITIVE(setenv)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_setenv();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_exit()
|
||||
{
|
||||
exit(to_fixnum(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE(micros)
|
||||
PRIMITIVE(exit)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_exit();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_micros()
|
||||
{
|
||||
box_unsigned_8(current_micros());
|
||||
}
|
||||
|
||||
PRIMITIVE(sleep)
|
||||
PRIMITIVE(micros)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_micros();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_sleep()
|
||||
{
|
||||
sleep_micros(to_cell(dpop()));
|
||||
}
|
||||
|
||||
PRIMITIVE(set_slot)
|
||||
PRIMITIVE(sleep)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_sleep();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_set_slot()
|
||||
{
|
||||
fixnum slot = untag_fixnum(dpop());
|
||||
object *obj = untag<object>(dpop());
|
||||
|
@ -45,7 +67,12 @@ PRIMITIVE(set_slot)
|
|||
write_barrier(obj);
|
||||
}
|
||||
|
||||
PRIMITIVE(load_locals)
|
||||
PRIMITIVE(set_slot)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_set_slot();
|
||||
}
|
||||
|
||||
inline void factorvm::vmprim_load_locals()
|
||||
{
|
||||
fixnum count = untag_fixnum(dpop());
|
||||
memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);
|
||||
|
@ -53,9 +80,14 @@ PRIMITIVE(load_locals)
|
|||
rs += sizeof(cell) * count;
|
||||
}
|
||||
|
||||
static cell clone_object(cell obj_)
|
||||
PRIMITIVE(load_locals)
|
||||
{
|
||||
gc_root<object> obj(obj_);
|
||||
PRIMITIVE_GETVM()->vmprim_load_locals();
|
||||
}
|
||||
|
||||
cell factorvm::clone_object(cell obj_)
|
||||
{
|
||||
gc_root<object> obj(obj_,this);
|
||||
|
||||
if(immediate_p(obj.value()))
|
||||
return obj.value();
|
||||
|
@ -68,9 +100,14 @@ static cell clone_object(cell obj_)
|
|||
}
|
||||
}
|
||||
|
||||
PRIMITIVE(clone)
|
||||
inline void factorvm::vmprim_clone()
|
||||
{
|
||||
drepl(clone_object(dpeek()));
|
||||
}
|
||||
|
||||
PRIMITIVE(clone)
|
||||
{
|
||||
PRIMITIVE_GETVM()->vmprim_clone();
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -98,9 +98,6 @@ inline static bool save_env_p(cell i)
|
|||
return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV;
|
||||
}
|
||||
|
||||
/* Canonical T object. It's just a word */
|
||||
extern cell T;
|
||||
|
||||
PRIMITIVE(getenv);
|
||||
PRIMITIVE(setenv);
|
||||
PRIMITIVE(exit);
|
||||
|
@ -112,5 +109,4 @@ PRIMITIVE(clone);
|
|||
|
||||
}
|
||||
|
||||
/* TAGGED user environment data; see getenv/setenv prims */
|
||||
VM_C_API factor::cell userenv[USER_ENV];
|
||||
|
||||
|
|
|
@ -7,9 +7,4 @@ struct segment {
|
|||
cell end;
|
||||
};
|
||||
|
||||
inline static cell align_page(cell a)
|
||||
{
|
||||
return align(a,getpagesize());
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -2,15 +2,15 @@ namespace factor
|
|||
{
|
||||
|
||||
#define DEFPUSHPOP(prefix,ptr) \
|
||||
inline static cell prefix##peek() { return *(cell *)ptr; } \
|
||||
inline static void prefix##repl(cell tagged) { *(cell *)ptr = tagged; } \
|
||||
inline static cell prefix##pop() \
|
||||
inline cell prefix##peek() { return *(cell *)ptr; } \
|
||||
inline void prefix##repl(cell tagged) { *(cell *)ptr = tagged; } \
|
||||
inline cell prefix##pop() \
|
||||
{ \
|
||||
cell value = prefix##peek(); \
|
||||
ptr -= sizeof(cell); \
|
||||
return value; \
|
||||
} \
|
||||
inline static void prefix##push(cell tagged) \
|
||||
inline void prefix##push(cell tagged) \
|
||||
{ \
|
||||
ptr += sizeof(cell); \
|
||||
prefix##repl(tagged); \
|
||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue