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

Merge Phil Dawes' VM work

db4
Slava Pestov 2009-09-20 03:48:08 -05:00
parent 0968938917 d2afb4b344
commit f8a91438cd
112 changed files with 4922 additions and 3150 deletions

26
Makefile
View File

@ -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

2
basis/compiler/cfg/alias-analysis/alias-analysis.factor
View File

@ -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

2
basis/compiler/cfg/hats/hats.factor
View File

@ -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

4
basis/compiler/cfg/instructions/instructions.factor
View File

@ -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 ;

2
basis/compiler/cfg/intrinsics/misc/misc.factor
View File

@ -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 ;

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

@ -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.

1
basis/compiler/constants/constants.factor
View File

@ -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? ;

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

@ -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 ;

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

@ -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? [

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

@ -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

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

@ -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

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

@ -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

3
basis/cpu/x86/64/bootstrap.factor
View File

@ -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

1
basis/cpu/x86/64/unix/bootstrap.factor
View File

@ -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

1
basis/cpu/x86/64/winnt/bootstrap.factor
View File

@ -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

2
basis/cpu/x86/bootstrap.factor
View File

@ -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

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

@ -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? [

1
basis/vm/authors.txt Normal file
View File

@ -0,0 +1 @@
Phil Dawes

1
basis/vm/summary.txt Normal file
View File

@ -0,0 +1 @@
Layout of the C vm structure

23
basis/vm/vm.factor Normal file
View File

@ -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 ;

2
core/bootstrap/primitives.factor
View File

@ -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

25
extra/mttest/mttest.factor Normal file
View File

@ -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

138
vm/alien.cpp Normal file → Executable file
View File

@ -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();
}
}

18
vm/alien.hpp Normal file → Executable file
View File

@ -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);
}

60
vm/arrays.cpp
View File

@ -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);
}
}

28
vm/arrays.hpp Normal file → Executable file
View File

@ -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();
};
}

2843
vm/bignum.cpp Normal file → Executable file
View File

File diff suppressed because it is too large Load Diff

82
vm/bignum.hpp
View File

@ -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);

16
vm/booleans.cpp
View File

@ -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);
}
}

8
vm/booleans.hpp
View File

@ -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);
}

37
vm/byte_arrays.cpp
View File

@ -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);
}
}

13
vm/byte_arrays.hpp Normal file → Executable file
View File

@ -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();
};
}

95
vm/callstack.cpp Normal file → Executable file
View File

@ -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);
}
}

33
vm/callstack.hpp Normal file → Executable file
View File

@ -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);
}
}
}

172
vm/code_block.cpp Normal file → Executable file
View File

@ -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;
}
}

39
vm/code_block.hpp
View File

@ -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);
}

49
vm/code_gc.cpp Normal file → Executable file
View File

@ -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
vm/code_gc.hpp Normal file → Executable file
View File

@ -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)
{

71
vm/code_heap.cpp Normal file → Executable file
View File

@ -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();

27
vm/code_heap.hpp Normal file → Executable file
View File

@ -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
}
}

73
vm/contexts.cpp
View File

@ -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();
}
}

14
vm/contexts.hpp
View File

@ -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;

7
vm/cpu-ppc.hpp
View File

@ -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,

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

@ -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

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

@ -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)))
}

27
vm/cpu-x86.64.S
View File

@ -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"

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

@ -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
View File

@ -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"

6
vm/cpu-x86.hpp
View File

@ -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,

150
vm/data_gc.cpp Normal file → Executable file
View File

@ -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);
}
}

127
vm/data_gc.hpp Normal file → Executable file
View File

@ -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);
}

125
vm/data_heap.cpp Normal file → Executable file
View File

@ -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();
}
}

62
vm/data_heap.hpp Normal file → Executable file
View File

@ -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;

86
vm/debug.cpp Normal file → Executable file
View File

@ -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();
}
}

5
vm/debug.hpp Normal file → Executable file
View File

@ -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);

69
vm/dispatch.cpp Normal file → Executable file
View File

@ -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]);
}
}

12
vm/dispatch.hpp
View File

@ -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);
}

69
vm/errors.cpp Normal file → Executable file
View File

@ -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();
}
}

22
vm/errors.hpp Normal file → Executable file
View File

@ -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();

93
vm/factor.cpp Normal file → Executable file
View File

@ -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);
}
}

14
vm/factor.hpp
View File

@ -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);
}

37
vm/generic_arrays.hpp
View File

@ -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;
}
}
}

96
vm/image.cpp Normal file → Executable file
View File

@ -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);
}
}

3
vm/image.hpp Normal file → Executable file
View File

@ -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);

101
vm/inline_cache.cpp Normal file → Executable file
View File

@ -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();
}
}

7
vm/inline_cache.hpp
View File

@ -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);
}

405
vm/inlineimpls.hpp Normal file
View File

@ -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
}
}

73
vm/io.cpp Normal file → Executable file
View File

@ -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;
}
}

3
vm/io.hpp Normal file → Executable file
View File

@ -1,9 +1,6 @@
namespace factor
{
void init_c_io();
void io_error();
PRIMITIVE(fopen);
PRIMITIVE(fgetc);
PRIMITIVE(fread);

31
vm/jit.cpp
View File

@ -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
View File

@ -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());
}

5
vm/local_roots.cpp
View File

@ -2,9 +2,4 @@
namespace factor
{
std::vector<cell> gc_locals;
std::vector<cell> gc_bignums;
}

48
vm/local_roots.hpp
View File

@ -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)
}

23
vm/mach_signal.cpp
View File

@ -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

1
vm/main-unix.cpp
View File

@ -2,6 +2,7 @@
int main(int argc, char **argv)
{
factor::init_globals();
factor::start_standalone_factor(argc,argv);
return 0;
}

6
vm/main-windows-nt.cpp
View File

@ -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);

11
vm/master.hpp Normal file → Executable file
View File

@ -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__ */

503
vm/math.cpp Normal file → Executable file
View File

@ -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
View File

@ -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);
}

4
vm/os-genunix.cpp
View File

@ -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()

2
vm/os-linux-arm.cpp
View File

@ -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);
}
}

6
vm/os-linux.cpp
View File

@ -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;
}

4
vm/os-macosx.mm
View File

@ -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));

93
vm/os-unix.cpp
View File

@ -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()

13
vm/os-unix.hpp
View File

@ -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();
}

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

@ -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() { }

64
vm/os-windows-nt.cpp
View File

@ -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()
{
}

11
vm/os-windows-nt.hpp
View File

@ -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();
}

38
vm/os-windows.cpp
View File

@ -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));
}

9
vm/os-windows.hpp
View File

@ -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();

1
vm/primitives.cpp
View File

@ -162,6 +162,7 @@ const primitive_type primitives[] = {
primitive_inline_cache_stats,
primitive_optimized_p,
primitive_quot_compiled_p,
primitive_vm_ptr,
};
}

12
vm/primitives.hpp
View File

@ -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()
}

29
vm/profiler.cpp Normal file → Executable file
View File

@ -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();
}
}

3
vm/profiler.hpp Normal file → Executable file
View File

@ -1,9 +1,6 @@
namespace factor
{
extern bool profiling_p;
void init_profiler();
code_block *compile_profiling_stub(cell word);
PRIMITIVE(profiling);
}

122
vm/quotations.cpp Normal file → Executable file
View File

@ -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();
}
}

16
vm/quotations.hpp Normal file → Executable file
View File

@ -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);

63
vm/run.cpp Normal file → Executable file
View File

@ -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();
}
}

6
vm/run.hpp Normal file → Executable file
View File

@ -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];

5
vm/segments.hpp
View File

@ -7,9 +7,4 @@ struct segment {
cell end;
};
inline static cell align_page(cell a)
{
return align(a,getpagesize());
}
}

8
vm/stacks.hpp
View File

@ -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