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

vm: actually use context callstacks when running code

release
Slava Pestov 2010-03-26 22:44:43 -04:00
parent dde21c3cc4
commit 560c119cd2
36 changed files with 557 additions and 406 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/bootstrap/image/image.factor
View File

@ -129,8 +129,8 @@ SYMBOL: jit-literals
: jit-vm ( offset rc -- ) : jit-vm ( offset rc -- )
[ jit-parameter ] dip rt-vm jit-rel ; [ jit-parameter ] dip rt-vm jit-rel ;
: jit-dlsym ( name library rc -- ) : jit-dlsym ( name rc -- )
rt-dlsym jit-rel [ string>symbol jit-parameter ] bi@ ; rt-dlsym jit-rel string>symbol jit-parameter f jit-parameter ;
:: jit-conditional ( test-quot false-quot -- ) :: jit-conditional ( test-quot false-quot -- )
[ 0 test-quot call ] B{ } make length :> len [ 0 test-quot call ] B{ } make length :> len

4
basis/command-line/command-line-docs.factor
View File

@ -43,14 +43,16 @@ ARTICLE: "runtime-cli-args" "Command line switches for the VM"
{ { $snippet "-i=" { $emphasis "image" } } { "Specifies the image file to use; see " { $link "images" } } } { { $snippet "-i=" { $emphasis "image" } } { "Specifies the image file to use; see " { $link "images" } } }
{ { $snippet "-datastack=" { $emphasis "n" } } "Data stack size, kilobytes" } { { $snippet "-datastack=" { $emphasis "n" } } "Data stack size, kilobytes" }
{ { $snippet "-retainstack=" { $emphasis "n" } } "Retain stack size, kilobytes" } { { $snippet "-retainstack=" { $emphasis "n" } } "Retain stack size, kilobytes" }
{ { $snippet "-callstack=" { $emphasis "n" } } "Call stack size, kilobytes" }
{ { $snippet "-young=" { $emphasis "n" } } { "Size of youngest generation (0), megabytes" } } { { $snippet "-young=" { $emphasis "n" } } { "Size of youngest generation (0), megabytes" } }
{ { $snippet "-aging=" { $emphasis "n" } } "Size of aging generation (1), megabytes" } { { $snippet "-aging=" { $emphasis "n" } } "Size of aging generation (1), megabytes" }
{ { $snippet "-tenured=" { $emphasis "n" } } "Size of oldest generation (2), megabytes" } { { $snippet "-tenured=" { $emphasis "n" } } "Size of oldest generation (2), megabytes" }
{ { $snippet "-codeheap=" { $emphasis "n" } } "Code heap size, megabytes" } { { $snippet "-codeheap=" { $emphasis "n" } } "Code heap size, megabytes" }
{ { $snippet "-callbacks=" { $emphasis "n" } } "Callback heap size, megabytes" }
{ { $snippet "-pic=" { $emphasis "n" } } "Maximum inline cache size. Setting of 0 disables inline caching, > 1 enables polymorphic inline caching" } { { $snippet "-pic=" { $emphasis "n" } } "Maximum inline cache size. Setting of 0 disables inline caching, > 1 enables polymorphic inline caching" }
{ { $snippet "-securegc" } "If specified, unused portions of the data heap will be zeroed out after every garbage collection" } { { $snippet "-securegc" } "If specified, unused portions of the data heap will be zeroed out after every garbage collection" }
} }
"If an " { $snippet "-i=" } " switch is not present, the default image file is used, which is usually a file named " { $snippet "factor.image" } " in the same directory as the runtime executable (on Windows and Mac OS X) or the current directory (on Unix)." ; "If an " { $snippet "-i=" } " switch is not present, the default image file is used, which is usually a file named " { $snippet "factor.image" } " in the same directory as the Factor executable." ;
ARTICLE: "bootstrap-cli-args" "Command line switches for bootstrap" ARTICLE: "bootstrap-cli-args" "Command line switches for bootstrap"
"A number of command line switches can be passed to a bootstrap image to modify the behavior of the resulting image:" "A number of command line switches can be passed to a bootstrap image to modify the behavior of the resulting image:"

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

@ -1,17 +1,17 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces make math sequences layouts USING: accessors kernel namespaces make math sequences layouts
alien.c-types cpu.architecture ; alien.c-types cpu.architecture ;
IN: compiler.alien IN: compiler.alien
: large-struct? ( ctype -- ? ) : large-struct? ( type -- ? )
dup c-struct? [ return-struct-in-registers? not ] [ drop f ] if ; dup c-struct? [ return-struct-in-registers? not ] [ drop f ] if ;
: alien-parameters ( params -- seq ) : alien-parameters ( params -- seq )
dup parameters>> dup parameters>>
swap return>> large-struct? [ void* prefix ] when ; swap return>> large-struct? [ void* prefix ] when ;
: alien-return ( params -- ctype ) : alien-return ( params -- type )
return>> dup large-struct? [ drop void ] when ; return>> dup large-struct? [ drop void ] when ;
: c-type-stack-align ( type -- align ) : c-type-stack-align ( type -- align )

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

@ -458,7 +458,7 @@ M: ##alien-indirect generate-insn
! Generate code for boxing input parameters in a callback. ! Generate code for boxing input parameters in a callback.
[ [
dup \ %save-param-reg move-parameters dup \ %save-param-reg move-parameters
%nest-stacks %begin-callback
box-parameters box-parameters
] with-param-regs ; ] with-param-regs ;
@ -482,5 +482,4 @@ M: ##alien-callback generate-insn
params>> params>>
[ registers>objects ] [ registers>objects ]
[ wrap-callback-quot %alien-callback ] [ wrap-callback-quot %alien-callback ]
[ alien-return [ %unnest-stacks ] [ %callback-value ] if-void ] [ alien-return [ %end-callback ] [ %end-callback-value ] if-void ] tri ;
tri ;

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

@ -28,10 +28,12 @@ CONSTANT: deck-bits 18
: callstack-length-offset ( -- n ) 1 \ callstack type-number slot-offset ; inline : callstack-length-offset ( -- n ) 1 \ callstack type-number slot-offset ; inline
: callstack-top-offset ( -- n ) 2 \ callstack type-number slot-offset ; inline : callstack-top-offset ( -- n ) 2 \ callstack type-number slot-offset ; inline
: vm-context-offset ( -- n ) 0 bootstrap-cells ; inline : vm-context-offset ( -- n ) 0 bootstrap-cells ; inline
: vm-spare-context-offset ( -- n ) 1 bootstrap-cells ; inline
: context-callstack-top-offset ( -- n ) 0 bootstrap-cells ; inline : context-callstack-top-offset ( -- n ) 0 bootstrap-cells ; inline
: context-callstack-bottom-offset ( -- n ) 1 bootstrap-cells ; inline : context-callstack-bottom-offset ( -- n ) 1 bootstrap-cells ; inline
: context-datastack-offset ( -- n ) 2 bootstrap-cells ; inline : context-datastack-offset ( -- n ) 2 bootstrap-cells ; inline
: context-retainstack-offset ( -- n ) 3 bootstrap-cells ; inline : context-retainstack-offset ( -- n ) 3 bootstrap-cells ; inline
: context-callstack-save-offset ( -- n ) 4 bootstrap-cells ; inline
! Relocation classes ! Relocation classes
CONSTANT: rc-absolute-cell 0 CONSTANT: rc-absolute-cell 0

17
basis/compiler/tests/alien.factor
View File

@ -4,7 +4,7 @@ compiler continuations effects io io.backend io.pathnames
io.streams.string kernel math memory namespaces io.streams.string kernel math memory namespaces
namespaces.private parser quotations sequences namespaces.private parser quotations sequences
specialized-arrays stack-checker stack-checker.errors specialized-arrays stack-checker stack-checker.errors
system threads tools.test words alien.complex ; system threads tools.test words alien.complex concurrency.promises ;
FROM: alien.c-types => float short ; FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: char
@ -579,6 +579,21 @@ FUNCTION: short ffi_test_48 ( bool-field-test x ) ;
] unless ] unless
! Test interaction between threads and callbacks
: thread-callback-1 ( -- callback )
int { } "cdecl" [ yield 100 ] alien-callback ;
: thread-callback-2 ( -- callback )
int { } "cdecl" [ yield 200 ] alien-callback ;
: thread-callback-invoker ( callback -- n )
int { } "cdecl" alien-indirect ;
<promise> "p" set
[ thread-callback-1 thread-callback-invoker "p" get fulfill ] in-thread
[ 200 ] [ thread-callback-2 thread-callback-invoker ] unit-test
[ 100 ] [ "p" get ?promise ] unit-test
! Regression: calling an undefined function would raise a protection fault ! Regression: calling an undefined function would raise a protection fault
FUNCTION: void this_does_not_exist ( ) ; FUNCTION: void this_does_not_exist ( ) ;

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

@ -582,13 +582,13 @@ HOOK: %prepare-alien-indirect cpu ( -- )
HOOK: %alien-indirect cpu ( -- ) HOOK: %alien-indirect cpu ( -- )
HOOK: %begin-callback cpu ( -- )
HOOK: %alien-callback cpu ( quot -- ) HOOK: %alien-callback cpu ( quot -- )
HOOK: %callback-value cpu ( ctype -- ) HOOK: %end-callback cpu ( -- )
HOOK: %nest-stacks cpu ( -- ) HOOK: %end-callback-value cpu ( c-type -- )
HOOK: %unnest-stacks cpu ( -- )
HOOK: callback-return-rewind cpu ( params -- n ) HOOK: callback-return-rewind cpu ( params -- n )

10
basis/cpu/ppc/bootstrap.factor
View File

@ -267,7 +267,7 @@ CONSTANT: ctx-reg 16
jit-save-context jit-save-context
3 6 MR 3 6 MR
4 vm-reg MR 4 vm-reg MR
0 5 LOAD32 "inline_cache_miss" f rc-absolute-ppc-2/2 jit-dlsym 0 5 LOAD32 "inline_cache_miss" rc-absolute-ppc-2/2 jit-dlsym
5 MTLR 5 MTLR
BLRL BLRL
jit-restore-context ; jit-restore-context ;
@ -392,7 +392,7 @@ CONSTANT: ctx-reg 16
1 3 MR 1 3 MR
! Call memcpy; arguments are now in the correct registers ! Call memcpy; arguments are now in the correct registers
1 1 -64 STWU 1 1 -64 STWU
0 2 LOAD32 "factor_memcpy" f rc-absolute-ppc-2/2 jit-dlsym 0 2 LOAD32 "factor_memcpy" rc-absolute-ppc-2/2 jit-dlsym
2 MTLR 2 MTLR
BLRL BLRL
1 1 0 LWZ 1 1 0 LWZ
@ -405,7 +405,7 @@ CONSTANT: ctx-reg 16
[ [
jit-save-context jit-save-context
4 vm-reg MR 4 vm-reg MR
0 2 LOAD32 "lazy_jit_compile" f rc-absolute-ppc-2/2 jit-dlsym 0 2 LOAD32 "lazy_jit_compile" rc-absolute-ppc-2/2 jit-dlsym
2 MTLR 2 MTLR
BLRL BLRL
5 3 quot-entry-point-offset LWZ 5 3 quot-entry-point-offset LWZ
@ -665,7 +665,7 @@ CONSTANT: ctx-reg 16
[ BNO ] [ BNO ]
[ [
5 vm-reg MR 5 vm-reg MR
0 6 LOAD32 func f rc-absolute-ppc-2/2 jit-dlsym 0 6 LOAD32 func rc-absolute-ppc-2/2 jit-dlsym
6 MTLR 6 MTLR
BLRL BLRL
] ]
@ -689,7 +689,7 @@ CONSTANT: ctx-reg 16
[ [
4 4 tag-bits get SRAWI 4 4 tag-bits get SRAWI
5 vm-reg MR 5 vm-reg MR
0 6 LOAD32 "overflow_fixnum_multiply" f rc-absolute-ppc-2/2 jit-dlsym 0 6 LOAD32 "overflow_fixnum_multiply" rc-absolute-ppc-2/2 jit-dlsym
6 MTLR 6 MTLR
BLRL BLRL
] ]

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

@ -716,7 +716,7 @@ M: ppc %callback-value ( ctype -- )
3 1 0 local@ STW 3 1 0 local@ STW
3 %load-vm-addr 3 %load-vm-addr
! Restore data/call/retain stacks ! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke "unnest_context" f %alien-invoke
! Restore top of data stack ! Restore top of data stack
3 1 0 local@ LWZ 3 1 0 local@ LWZ
! Unbox former top of data stack to return registers ! Unbox former top of data stack to return registers
@ -757,13 +757,13 @@ M: ppc %box-small-struct ( c-type -- )
4 3 4 LWZ 4 3 4 LWZ
3 3 0 LWZ ; 3 3 0 LWZ ;
M: ppc %nest-stacks ( -- ) M: ppc %nest-context ( -- )
3 %load-vm-addr 3 %load-vm-addr
"nest_stacks" f %alien-invoke ; "nest_context" f %alien-invoke ;
M: ppc %unnest-stacks ( -- ) M: ppc %unnest-context ( -- )
3 %load-vm-addr 3 %load-vm-addr
"unnest_stacks" f %alien-invoke ; "unnest_context" f %alien-invoke ;
M: ppc %unbox-small-struct ( size -- ) M: ppc %unbox-small-struct ( size -- )
heap-size cell align cell /i { heap-size cell align cell /i {

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

@ -228,14 +228,6 @@ M:: x86.32 %unbox-large-struct ( n c-type -- )
0 stack@ EAX MOV 0 stack@ EAX MOV
"to_value_struct" f %alien-invoke ; "to_value_struct" f %alien-invoke ;
M: x86.32 %nest-stacks ( -- )
0 save-vm-ptr
"nest_stacks" f %alien-invoke ;
M: x86.32 %unnest-stacks ( -- )
0 save-vm-ptr
"unnest_stacks" f %alien-invoke ;
M: x86.32 %prepare-alien-indirect ( -- ) M: x86.32 %prepare-alien-indirect ( -- )
EAX ds-reg [] MOV EAX ds-reg [] MOV
ds-reg 4 SUB ds-reg 4 SUB
@ -247,18 +239,24 @@ M: x86.32 %prepare-alien-indirect ( -- )
M: x86.32 %alien-indirect ( -- ) M: x86.32 %alien-indirect ( -- )
EBP CALL ; EBP CALL ;
M: x86.32 %begin-callback ( -- )
0 save-vm-ptr
"begin_callback" f %alien-invoke ;
M: x86.32 %alien-callback ( quot -- ) M: x86.32 %alien-callback ( quot -- )
EAX EDX %restore-context EAX EDX %restore-context
EAX swap %load-reference EAX swap %load-reference
EAX quot-entry-point-offset [+] CALL EAX quot-entry-point-offset [+] CALL
EAX EDX %save-context ; EAX EDX %save-context ;
M: x86.32 %callback-value ( ctype -- ) M: x86.32 %end-callback ( -- )
0 save-vm-ptr
"end_callback" f %alien-invoke ;
M: x86.32 %end-callback-value ( ctype -- )
%pop-context-stack %pop-context-stack
4 stack@ EAX MOV 4 stack@ EAX MOV
0 save-vm-ptr %end-callback
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
! Place former top of data stack back in EAX ! Place former top of data stack back in EAX
EAX 4 stack@ MOV EAX 4 stack@ MOV
! Unbox EAX ! Unbox EAX

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

@ -16,17 +16,20 @@ IN: bootstrap.x86
: temp1 ( -- reg ) EDX ; : temp1 ( -- reg ) EDX ;
: temp2 ( -- reg ) ECX ; : temp2 ( -- reg ) ECX ;
: temp3 ( -- reg ) EBX ; : temp3 ( -- reg ) EBX ;
: safe-reg ( -- reg ) EAX ;
: stack-reg ( -- reg ) ESP ; : stack-reg ( -- reg ) ESP ;
: frame-reg ( -- reg ) EBP ; : frame-reg ( -- reg ) EBP ;
: vm-reg ( -- reg ) ECX ; : vm-reg ( -- reg ) ECX ;
: ctx-reg ( -- reg ) EBP ; : ctx-reg ( -- reg ) EBP ;
: nv-regs ( -- seq ) { ESI EDI EBX } ; : nv-regs ( -- seq ) { ESI EDI EBX } ;
: nv-reg ( -- reg ) nv-regs first ;
: ds-reg ( -- reg ) ESI ; : ds-reg ( -- reg ) ESI ;
: rs-reg ( -- reg ) EDI ; : rs-reg ( -- reg ) EDI ;
: fixnum>slot@ ( -- ) temp0 2 SAR ; : fixnum>slot@ ( -- ) temp0 2 SAR ;
: rex-length ( -- n ) 0 ; : rex-length ( -- n ) 0 ;
: jit-call ( name -- )
0 CALL rc-relative jit-dlsym ;
[ [
! save stack frame size ! save stack frame size
stack-frame-size PUSH stack-frame-size PUSH
@ -49,7 +52,7 @@ IN: bootstrap.x86
ctx-reg vm-reg vm-context-offset [+] MOV ; ctx-reg vm-reg vm-context-offset [+] MOV ;
: jit-save-context ( -- ) : jit-save-context ( -- )
EDX RSP -4 [+] LEA EDX ESP -4 [+] LEA
ctx-reg context-callstack-top-offset [+] EDX MOV ctx-reg context-callstack-top-offset [+] EDX MOV
ctx-reg context-datastack-offset [+] ds-reg MOV ctx-reg context-datastack-offset [+] ds-reg MOV
ctx-reg context-retainstack-offset [+] rs-reg MOV ; ctx-reg context-retainstack-offset [+] rs-reg MOV ;
@ -70,18 +73,37 @@ IN: bootstrap.x86
] jit-primitive jit-define ] jit-primitive jit-define
[ [
! Load quotation jit-load-vm
ESP [] vm-reg MOV
"begin_callback" jit-call
! load quotation - EBP is ctx-reg so it will get clobbered
! later on
EAX EBP 8 [+] MOV EAX EBP 8 [+] MOV
! save ctx->callstack_bottom, load ds, rs registers
jit-load-vm jit-load-vm
jit-load-context jit-load-context
jit-restore-context jit-restore-context
EDX stack-reg stack-frame-size 4 - [+] LEA
ctx-reg context-callstack-bottom-offset [+] EDX MOV ! save C callstack pointer
ctx-reg context-callstack-save-offset [+] ESP MOV
! load Factor callstack pointer
ESP ctx-reg context-callstack-bottom-offset [+] MOV
ESP 4 ADD
! call the quotation ! call the quotation
EAX quot-entry-point-offset [+] CALL EAX quot-entry-point-offset [+] CALL
! save ds, rs registers
jit-load-vm
jit-load-context
jit-save-context jit-save-context
! load C callstack pointer
ESP ctx-reg context-callstack-save-offset [+] MOV
ESP [] vm-reg MOV
"end_callback" jit-call
] \ c-to-factor define-sub-primitive ] \ c-to-factor define-sub-primitive
[ [
@ -137,7 +159,7 @@ IN: bootstrap.x86
EDX PUSH EDX PUSH
EBP PUSH EBP PUSH
EAX PUSH EAX PUSH
0 CALL "factor_memcpy" f rc-relative jit-dlsym "factor_memcpy" jit-call
ESP 12 ADD ESP 12 ADD
! Return with new callstack ! Return with new callstack
0 RET 0 RET
@ -153,7 +175,7 @@ IN: bootstrap.x86
ESP 4 [+] vm-reg MOV ESP 4 [+] vm-reg MOV
! Call VM ! Call VM
0 CALL "lazy_jit_compile" f rc-relative jit-dlsym "lazy_jit_compile" jit-call
] ]
[ EAX quot-entry-point-offset [+] CALL ] [ EAX quot-entry-point-offset [+] CALL ]
[ EAX quot-entry-point-offset [+] JMP ] [ EAX quot-entry-point-offset [+] JMP ]
@ -171,7 +193,7 @@ IN: bootstrap.x86
jit-save-context jit-save-context
ESP 4 [+] vm-reg MOV ESP 4 [+] vm-reg MOV
ESP [] EBX MOV ESP [] EBX MOV
0 CALL "inline_cache_miss" f rc-relative jit-dlsym "inline_cache_miss" jit-call
jit-restore-context ; jit-restore-context ;
[ jit-load-return-address jit-inline-cache-miss ] [ jit-load-return-address jit-inline-cache-miss ]
@ -200,7 +222,7 @@ IN: bootstrap.x86
ESP [] EAX MOV ESP [] EAX MOV
ESP 4 [+] EDX MOV ESP 4 [+] EDX MOV
ESP 8 [+] vm-reg MOV ESP 8 [+] vm-reg MOV
[ 0 CALL ] dip f rc-relative jit-dlsym jit-call
] ]
jit-conditional ; jit-conditional ;
@ -225,7 +247,7 @@ IN: bootstrap.x86
ESP [] EBX MOV ESP [] EBX MOV
ESP 4 [+] EBP MOV ESP 4 [+] EBP MOV
ESP 8 [+] vm-reg MOV ESP 8 [+] vm-reg MOV
0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym "overflow_fixnum_multiply" jit-call
] ]
jit-conditional jit-conditional
] \ fixnum* define-sub-primitive ] \ fixnum* define-sub-primitive

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

@ -38,6 +38,7 @@ M: x86.64 machine-registers
} ; } ;
: vm-reg ( -- reg ) R13 ; inline : vm-reg ( -- reg ) R13 ; inline
: nv-reg ( -- reg ) RBX ; inline
M: x86.64 %mov-vm-ptr ( reg -- ) M: x86.64 %mov-vm-ptr ( reg -- )
vm-reg MOV ; vm-reg MOV ;
@ -215,23 +216,19 @@ M: x86.64 %alien-invoke
rc-absolute-cell rel-dlsym rc-absolute-cell rel-dlsym
R11 CALL ; R11 CALL ;
M: x86.64 %nest-stacks ( -- )
param-reg-0 %mov-vm-ptr
"nest_stacks" f %alien-invoke ;
M: x86.64 %unnest-stacks ( -- )
param-reg-0 %mov-vm-ptr
"unnest_stacks" f %alien-invoke ;
M: x86.64 %prepare-alien-indirect ( -- ) M: x86.64 %prepare-alien-indirect ( -- )
param-reg-0 ds-reg [] MOV param-reg-0 ds-reg [] MOV
ds-reg 8 SUB ds-reg 8 SUB
param-reg-1 %mov-vm-ptr param-reg-1 %mov-vm-ptr
"pinned_alien_offset" f %alien-invoke "pinned_alien_offset" f %alien-invoke
RBP RAX MOV ; nv-reg RAX MOV ;
M: x86.64 %alien-indirect ( -- ) M: x86.64 %alien-indirect ( -- )
RBP CALL ; nv-reg CALL ;
M: x86.64 %begin-callback ( -- )
param-reg-0 %mov-vm-ptr
"begin_callback" f %alien-invoke ;
M: x86.64 %alien-callback ( quot -- ) M: x86.64 %alien-callback ( quot -- )
param-reg-0 param-reg-1 %restore-context param-reg-0 param-reg-1 %restore-context
@ -239,16 +236,15 @@ M: x86.64 %alien-callback ( quot -- )
param-reg-0 quot-entry-point-offset [+] CALL param-reg-0 quot-entry-point-offset [+] CALL
param-reg-0 param-reg-1 %save-context ; param-reg-0 param-reg-1 %save-context ;
M: x86.64 %callback-value ( ctype -- ) M: x86.64 %end-callback ( -- )
%pop-context-stack
RSP 8 SUB
param-reg-0 PUSH
param-reg-0 %mov-vm-ptr param-reg-0 %mov-vm-ptr
! Restore data/call/retain stacks "end_callback" f %alien-invoke ;
"unnest_stacks" f %alien-invoke
! Put former top of data stack in param-reg-0 M: x86.64 %end-callback-value ( ctype -- )
param-reg-0 POP %pop-context-stack
RSP 8 ADD nv-reg param-reg-0 MOV
%end-callback
param-reg-0 nv-reg MOV
! Unbox former top of data stack to return registers ! Unbox former top of data stack to return registers
unbox-return ; unbox-return ;

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

@ -16,7 +16,7 @@ IN: bootstrap.x86
: temp2 ( -- reg ) RDX ; : temp2 ( -- reg ) RDX ;
: temp3 ( -- reg ) RBX ; : temp3 ( -- reg ) RBX ;
: return-reg ( -- reg ) RAX ; : return-reg ( -- reg ) RAX ;
: safe-reg ( -- reg ) RAX ; : nv-reg ( -- reg ) nv-regs first ;
: stack-reg ( -- reg ) RSP ; : stack-reg ( -- reg ) RSP ;
: frame-reg ( -- reg ) RBP ; : frame-reg ( -- reg ) RBP ;
: ctx-reg ( -- reg ) R12 ; : ctx-reg ( -- reg ) R12 ;
@ -26,13 +26,17 @@ IN: bootstrap.x86
: fixnum>slot@ ( -- ) temp0 1 SAR ; : fixnum>slot@ ( -- ) temp0 1 SAR ;
: rex-length ( -- n ) 1 ; : rex-length ( -- n ) 1 ;
: jit-call ( name -- )
RAX 0 MOV rc-absolute-cell jit-dlsym
RAX CALL ;
[ [
! load entry point ! load entry point
safe-reg 0 MOV rc-absolute-cell rt-this jit-rel RAX 0 MOV rc-absolute-cell rt-this jit-rel
! save stack frame size ! save stack frame size
stack-frame-size PUSH stack-frame-size PUSH
! push entry point ! push entry point
safe-reg PUSH RAX PUSH
! alignment ! alignment
RSP stack-frame-size 3 bootstrap-cells - SUB RSP stack-frame-size 3 bootstrap-cells - SUB
] jit-prolog jit-define ] jit-prolog jit-define
@ -47,8 +51,8 @@ IN: bootstrap.x86
: jit-save-context ( -- ) : jit-save-context ( -- )
jit-load-context jit-load-context
safe-reg RSP -8 [+] LEA RAX RSP -8 [+] LEA
ctx-reg context-callstack-top-offset [+] safe-reg MOV ctx-reg context-callstack-top-offset [+] RAX MOV
ctx-reg context-datastack-offset [+] ds-reg MOV ctx-reg context-datastack-offset [+] ds-reg MOV
ctx-reg context-retainstack-offset [+] rs-reg MOV ; ctx-reg context-retainstack-offset [+] rs-reg MOV ;
@ -67,13 +71,31 @@ IN: bootstrap.x86
] jit-primitive jit-define ] jit-primitive jit-define
[ [
nv-reg arg1 MOV
arg1 vm-reg MOV
"begin_callback" jit-call
jit-restore-context jit-restore-context
! save ctx->callstack_bottom
safe-reg stack-reg stack-frame-size 8 - [+] LEA ! save C callstack pointer
ctx-reg context-callstack-bottom-offset [+] safe-reg MOV ctx-reg context-callstack-save-offset [+] stack-reg MOV
! load Factor callstack pointer
stack-reg ctx-reg context-callstack-bottom-offset [+] MOV
stack-reg 8 ADD
! call the quotation ! call the quotation
arg1 nv-reg MOV
arg1 quot-entry-point-offset [+] CALL arg1 quot-entry-point-offset [+] CALL
jit-save-context jit-save-context
! load C callstack pointer
stack-reg ctx-reg context-callstack-save-offset [+] MOV
arg1 vm-reg MOV
"end_callback" jit-call
] \ c-to-factor define-sub-primitive ] \ c-to-factor define-sub-primitive
[ [
@ -124,8 +146,7 @@ IN: bootstrap.x86
! Call memcpy; arguments are now in the correct registers ! Call memcpy; arguments are now in the correct registers
! Create register shadow area for Win64 ! Create register shadow area for Win64
RSP 32 SUB RSP 32 SUB
safe-reg 0 MOV "factor_memcpy" f rc-absolute-cell jit-dlsym "factor_memcpy" jit-call
safe-reg CALL
! Tear down register shadow area ! Tear down register shadow area
RSP 32 ADD RSP 32 ADD
! Return with new callstack ! Return with new callstack
@ -135,8 +156,7 @@ IN: bootstrap.x86
[ [
jit-save-context jit-save-context
arg2 vm-reg MOV arg2 vm-reg MOV
safe-reg 0 MOV "lazy_jit_compile" f rc-absolute-cell jit-dlsym "lazy_jit_compile" jit-call
safe-reg CALL
] ]
[ return-reg quot-entry-point-offset [+] CALL ] [ return-reg quot-entry-point-offset [+] CALL ]
[ return-reg quot-entry-point-offset [+] JMP ] [ return-reg quot-entry-point-offset [+] JMP ]
@ -152,8 +172,7 @@ IN: bootstrap.x86
jit-save-context jit-save-context
arg1 RBX MOV arg1 RBX MOV
arg2 vm-reg MOV arg2 vm-reg MOV
RAX 0 MOV "inline_cache_miss" f rc-absolute-cell jit-dlsym "inline_cache_miss" jit-call
RAX CALL
jit-restore-context ; jit-restore-context ;
[ jit-load-return-address jit-inline-cache-miss ] [ jit-load-return-address jit-inline-cache-miss ]
@ -176,11 +195,7 @@ IN: bootstrap.x86
[ [ arg3 arg2 ] dip call ] dip [ [ arg3 arg2 ] dip call ] dip
ds-reg [] arg3 MOV ds-reg [] arg3 MOV
[ JNO ] [ JNO ]
[ [ arg3 vm-reg MOV jit-call ]
arg3 vm-reg MOV
RAX 0 MOV f rc-absolute-cell jit-dlsym
RAX CALL
]
jit-conditional ; inline jit-conditional ; inline
[ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
@ -202,8 +217,7 @@ IN: bootstrap.x86
arg1 tag-bits get SAR arg1 tag-bits get SAR
arg2 RBX MOV arg2 RBX MOV
arg3 vm-reg MOV arg3 vm-reg MOV
RAX 0 MOV "overflow_fixnum_multiply" f rc-absolute-cell jit-dlsym "overflow_fixnum_multiply" jit-call
RAX CALL
] ]
jit-conditional jit-conditional
] \ fixnum* define-sub-primitive ] \ fixnum* define-sub-primitive

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

@ -13,35 +13,45 @@ big-endian off
! Optimizing compiler's side of callback accesses ! Optimizing compiler's side of callback accesses
! arguments that are on the stack via the frame pointer. ! arguments that are on the stack via the frame pointer.
! On x86-64, some arguments are passed in registers, and ! On x86-64, some arguments are passed in registers, and
! so the only register that is safe for use here is safe-reg. ! so the only register that is safe for use here is nv-reg.
frame-reg PUSH frame-reg PUSH
frame-reg stack-reg MOV frame-reg stack-reg MOV
! Save all non-volatile registers ! Save all non-volatile registers
nv-regs [ PUSH ] each nv-regs [ PUSH ] each
! Save old stack pointer and align ! Load VM into vm-reg
safe-reg stack-reg MOV vm-reg 0 MOV rc-absolute-cell rt-vm jit-rel
stack-reg bootstrap-cell SUB
stack-reg -16 AND
stack-reg [] safe-reg MOV
! Register shadow area - only required on Win64, but doesn't ! Save old context
! hurt on other platforms nv-reg vm-reg vm-context-offset [+] MOV
stack-reg 32 SUB nv-reg PUSH
! Switch over to the spare context
nv-reg vm-reg vm-spare-context-offset [+] MOV
vm-reg vm-context-offset [+] nv-reg MOV
! Save C callstack pointer
nv-reg context-callstack-save-offset [+] stack-reg MOV
! Load Factor callstack pointer
stack-reg nv-reg context-callstack-bottom-offset [+] MOV
stack-reg bootstrap-cell ADD
! Call into Factor code
nv-reg 0 MOV rc-absolute-cell rt-entry-point jit-rel
nv-reg CALL
! Load VM into vm-reg ! Load VM into vm-reg
vm-reg 0 MOV rc-absolute-cell rt-vm jit-rel vm-reg 0 MOV rc-absolute-cell rt-vm jit-rel
! Call into Factor code ! Load C callstack pointer
safe-reg 0 MOV rc-absolute-cell rt-entry-point jit-rel nv-reg vm-reg vm-context-offset [+] MOV
safe-reg CALL stack-reg nv-reg context-callstack-save-offset [+] MOV
! Tear down register shadow area ! Load old context
stack-reg 32 ADD nv-reg POP
vm-reg vm-context-offset [+] nv-reg MOV
! Undo stack alignment
stack-reg stack-reg [] MOV
! Restore non-volatile registers ! Restore non-volatile registers
nv-regs <reversed> [ POP ] each nv-regs <reversed> [ POP ] each
@ -56,15 +66,15 @@ big-endian off
[ [
! Load word ! Load word
safe-reg 0 MOV rc-absolute-cell rt-literal jit-rel temp0 0 MOV rc-absolute-cell rt-literal jit-rel
! Bump profiling counter ! Bump profiling counter
safe-reg profile-count-offset [+] 1 tag-fixnum ADD temp0 profile-count-offset [+] 1 tag-fixnum ADD
! Load word->code ! Load word->code
safe-reg safe-reg word-code-offset [+] MOV temp0 temp0 word-code-offset [+] MOV
! Compute word entry point ! Compute word entry point
safe-reg compiled-header-size ADD temp0 compiled-header-size ADD
! Jump to entry point ! Jump to entry point
safe-reg JMP temp0 JMP
] jit-profiling jit-define ] jit-profiling jit-define
[ [

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

@ -1403,10 +1403,7 @@ M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
M:: x86 %restore-context ( temp1 temp2 -- ) M:: x86 %restore-context ( temp1 temp2 -- )
#! Load Factor stack pointers on entry from C to Factor. #! Load Factor stack pointers on entry from C to Factor.
#! Also save callstack bottom!
temp1 "ctx" %vm-field temp1 "ctx" %vm-field
temp2 stack-reg stack-frame get total-size>> cell - [+] LEA
temp1 "callstack-bottom" context-field-offset [+] temp2 MOV
ds-reg temp1 "datastack" context-field-offset [+] MOV ds-reg temp1 "datastack" context-field-offset [+] MOV
rs-reg temp1 "retainstack" context-field-offset [+] MOV ; rs-reg temp1 "retainstack" context-field-offset [+] MOV ;

39
basis/stack-checker/known-words/known-words.factor
View File

@ -1,19 +1,20 @@
! Copyright (C) 2004, 2010 Slava Pestov, Daniel Ehrenberg. ! Copyright (C) 2004, 2010 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors alien alien.accessors arrays byte-arrays USING: fry accessors alien alien.accessors alien.private arrays
classes continuations.private effects generic hashtables byte-arrays classes continuations.private effects generic
hashtables.private io io.backend io.files io.files.private hashtables hashtables.private io io.backend io.files
io.streams.c kernel kernel.private math math.private io.files.private io.streams.c kernel kernel.private math
math.parser.private memory memory.private namespaces math.private math.parser.private memory memory.private
namespaces.private parser quotations quotations.private sbufs namespaces namespaces.private parser quotations
sbufs.private sequences sequences.private slots.private strings quotations.private sbufs sbufs.private sequences
strings.private system threads.private classes.tuple sequences.private slots.private strings strings.private system
classes.tuple.private vectors vectors.private words threads.private classes.tuple classes.tuple.private vectors
words.private definitions assocs summary compiler.units vectors.private words words.private definitions assocs summary
system.private combinators combinators.short-circuit locals compiler.units system.private combinators
locals.backend locals.types combinators.private combinators.short-circuit locals locals.backend locals.types
stack-checker.values generic.single generic.single.private combinators.private stack-checker.values generic.single
alien.libraries tools.dispatch.private tools.profiler.private generic.single.private alien.libraries tools.dispatch.private
tools.profiler.private
stack-checker.alien stack-checker.alien
stack-checker.state stack-checker.state
stack-checker.errors stack-checker.errors
@ -504,6 +505,16 @@ M: bad-executable summary
\ word-code { word } { integer integer } define-primitive \ word-code { word } { integer integer } define-primitive
\ word-code make-flushable \ word-code make-flushable
\ current-callback { } { fixnum } define-primitive
\ current-callback make-flushable
\ current-context { } { c-ptr } define-primitive
\ current-context make-flushable
\ delete-context { c-ptr } { } define-primitive
\ start-context { quotation } { } define-primitive
\ special-object { fixnum } { object } define-primitive \ special-object { fixnum } { object } define-primitive
\ special-object make-flushable \ special-object make-flushable

8
basis/vm/vm.factor
View File

@ -10,12 +10,11 @@ STRUCT: context
{ callstack-bottom void* } { callstack-bottom void* }
{ datastack cell } { datastack cell }
{ retainstack cell } { retainstack cell }
{ magic-frame void* } { callstack-save cell }
{ context-objects cell[10] }
{ datastack-region void* } { datastack-region void* }
{ retainstack-region void* } { retainstack-region void* }
{ catchstack-save cell } { callstack-region void* } ;
{ current-callback-save cell }
{ next context* } ;
: context-field-offset ( field -- offset ) context offset-of ; inline : context-field-offset ( field -- offset ) context offset-of ; inline
@ -27,6 +26,7 @@ STRUCT: zone
STRUCT: vm STRUCT: vm
{ ctx context* } { ctx context* }
{ spare-ctx context* }
{ nursery zone } { nursery zone }
{ cards-offset cell } { cards-offset cell }
{ decks-offset cell } { decks-offset cell }

23
core/alien/alien.factor
View File

@ -94,26 +94,21 @@ SYMBOL: callbacks
[ H{ } clone callbacks set-global ] "alien" add-startup-hook [ H{ } clone callbacks set-global ] "alien" add-startup-hook
! Every context object in the VM is identified from the Factor ! Every callback invocation has a unique identifier in the VM.
! side by a unique identifier ! We make sure that the current callback is the right one before
TUPLE: context-id < identity-tuple ; ! returning from it, to avoid a bad interaction between threads
! and callbacks. See basis/compiler/tests/alien.factor for a
C: <context-id> context-id ! test case.
: wait-to-return ( yield-quot callback-id -- )
: context-id ( -- id ) 2 context-object ; dup current-callback eq?
: set-context-id ( id -- ) 2 set-context-object ;
: wait-to-return ( yield-quot id -- )
dup context-id eq?
[ 2drop ] [ over call( -- ) wait-to-return ] if ; [ 2drop ] [ over call( -- ) wait-to-return ] if ;
! Used by compiler.codegen to wrap callback bodies ! Used by compiler.codegen to wrap callback bodies
: do-callback ( callback-quot yield-quot -- ) : do-callback ( callback-quot yield-quot -- )
init-namespaces init-namespaces
init-catchstack init-catchstack
<context-id> current-callback
[ set-context-id drop call ] [ wait-to-return drop ] 3bi ; inline [ 2drop call ] [ wait-to-return drop ] 3bi ; inline
! A utility for defining global variables that are recompiled in ! A utility for defining global variables that are recompiled in
! every session ! every session

5
core/bootstrap/primitives.factor
View File

@ -63,6 +63,7 @@ call( -- )
"alien" "alien"
"alien.accessors" "alien.accessors"
"alien.libraries" "alien.libraries"
"alien.private"
"arrays" "arrays"
"byte-arrays" "byte-arrays"
"classes.private" "classes.private"
@ -415,6 +416,7 @@ tuple
{ "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) } { "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) }
{ "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) } { "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) }
{ "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) } { "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) }
{ "current-callback" "alien.private" "primitive_current_callback" (( -- n )) }
{ "<array>" "arrays" "primitive_array" (( n elt -- array )) } { "<array>" "arrays" "primitive_array" (( n elt -- array )) }
{ "resize-array" "arrays" "primitive_resize_array" (( n array -- newarray )) } { "resize-array" "arrays" "primitive_resize_array" (( n array -- newarray )) }
{ "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) } { "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) }
@ -532,6 +534,9 @@ tuple
{ "nano-count" "system" "primitive_nano_count" (( -- ns )) } { "nano-count" "system" "primitive_nano_count" (( -- ns )) }
{ "system-micros" "system" "primitive_system_micros" (( -- us )) } { "system-micros" "system" "primitive_system_micros" (( -- us )) }
{ "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) } { "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
{ "current-context" "threads.private" "primitive_current_context" (( -- c-ptr )) }
{ "delete-context" "threads.private" "primitive_delete_context" (( c-ptr -- )) }
{ "start-context" "threads.private" "primitive_start_context" (( quot -- )) }
{ "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) } { "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
{ "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) } { "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
{ "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) } { "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }

3
vm/callbacks.cpp
View File

@ -64,11 +64,12 @@ code_block *callback_heap::add(cell owner, cell return_rewind)
/* Store VM pointer */ /* Store VM pointer */
store_callback_operand(stub,0,(cell)parent); store_callback_operand(stub,0,(cell)parent);
store_callback_operand(stub,2,(cell)parent);
/* On x86, the RET instruction takes an argument which depends on /* On x86, the RET instruction takes an argument which depends on
the callback's calling convention */ the callback's calling convention */
#if defined(FACTOR_X86) || defined(FACTOR_AMD64) #if defined(FACTOR_X86) || defined(FACTOR_AMD64)
store_callback_operand(stub,2,return_rewind); store_callback_operand(stub,3,return_rewind);
#endif #endif
update(stub); update(stub);

2
vm/callstack.cpp
View File

@ -13,7 +13,7 @@ void factor_vm::check_frame(stack_frame *frame)
callstack *factor_vm::allot_callstack(cell size) callstack *factor_vm::allot_callstack(cell size)
{ {
callstack *stack = allot<callstack>(callstack_size(size)); callstack *stack = allot<callstack>(callstack_object_size(size));
stack->length = tag_fixnum(size); stack->length = tag_fixnum(size);
return stack; return stack;
} }

2
vm/callstack.hpp
View File

@ -1,7 +1,7 @@
namespace factor namespace factor
{ {
inline static cell callstack_size(cell size) inline static cell callstack_object_size(cell size)
{ {
return sizeof(callstack) + size; return sizeof(callstack) + size;
} }

2
vm/code_block_visitor.hpp
View File

@ -114,7 +114,7 @@ template<typename Visitor>
void code_block_visitor<Visitor>::visit_context_code_blocks() void code_block_visitor<Visitor>::visit_context_code_blocks()
{ {
call_frame_code_block_visitor<Visitor> call_frame_visitor(parent,visitor); call_frame_code_block_visitor<Visitor> call_frame_visitor(parent,visitor);
parent->iterate_active_frames(call_frame_visitor); parent->iterate_active_callstacks(call_frame_visitor);
} }
template<typename Visitor> template<typename Visitor>

155
vm/contexts.cpp
View File

@ -3,28 +3,32 @@
namespace factor namespace factor
{ {
context::context(cell ds_size, cell rs_size) : context::context(cell datastack_size, cell retainstack_size, cell callstack_size) :
callstack_top(NULL), callstack_top(NULL),
callstack_bottom(NULL), callstack_bottom(NULL),
datastack(0), datastack(0),
retainstack(0), retainstack(0),
datastack_region(new segment(ds_size,false)), callstack_save(0),
retainstack_region(new segment(rs_size,false)), datastack_seg(new segment(datastack_size,false)),
next(NULL) retainstack_seg(new segment(retainstack_size,false)),
callstack_seg(new segment(callstack_size,false))
{ {
reset_datastack(); reset();
reset_retainstack();
reset_context_objects();
} }
void context::reset_datastack() void context::reset_datastack()
{ {
datastack = datastack_region->start - sizeof(cell); datastack = datastack_seg->start - sizeof(cell);
} }
void context::reset_retainstack() void context::reset_retainstack()
{ {
retainstack = retainstack_region->start - sizeof(cell); retainstack = retainstack_seg->start - sizeof(cell);
}
void context::reset_callstack()
{
callstack_top = callstack_bottom = CALLSTACK_BOTTOM(this);
} }
void context::reset_context_objects() void context::reset_context_objects()
@ -32,68 +36,99 @@ void context::reset_context_objects()
memset_cell(context_objects,false_object,context_object_count * sizeof(cell)); memset_cell(context_objects,false_object,context_object_count * sizeof(cell));
} }
context *factor_vm::alloc_context() void context::reset()
{
reset_datastack();
reset_retainstack();
reset_callstack();
reset_context_objects();
}
context::~context()
{
delete datastack_seg;
delete retainstack_seg;
delete callstack_seg;
}
/* called on startup */
void factor_vm::init_contexts(cell datastack_size_, cell retainstack_size_, cell callstack_size_)
{
datastack_size = datastack_size_;
retainstack_size = retainstack_size_;
callstack_size = callstack_size_;
ctx = NULL;
spare_ctx = new_context();
}
void factor_vm::delete_contexts()
{
assert(!ctx);
std::vector<context *>::const_iterator iter = unused_contexts.begin();
std::vector<context *>::const_iterator end = unused_contexts.end();
while(iter != end)
{
delete *iter;
iter++;
}
}
context *factor_vm::new_context()
{ {
context *new_context; context *new_context;
if(unused_contexts) if(unused_contexts.empty())
{ {
new_context = unused_contexts; new_context = new context(datastack_size,
unused_contexts = unused_contexts->next; retainstack_size,
callstack_size);
} }
else else
new_context = new context(ds_size,rs_size); {
new_context = unused_contexts.back();
unused_contexts.pop_back();
}
new_context->reset();
active_contexts.insert(new_context);
return new_context; return new_context;
} }
void factor_vm::dealloc_context(context *old_context) void factor_vm::delete_context(context *old_context)
{ {
old_context->next = unused_contexts; unused_contexts.push_back(old_context);
unused_contexts = old_context; active_contexts.erase(old_context);
} }
/* called on entry into a compiled callback */ void factor_vm::begin_callback()
void factor_vm::nest_stacks()
{ {
context *new_ctx = alloc_context(); ctx->reset();
spare_ctx = new_context();
new_ctx->callstack_bottom = (stack_frame *)-1; callback_ids.push_back(callback_id++);
new_ctx->callstack_top = (stack_frame *)-1;
new_ctx->reset_datastack();
new_ctx->reset_retainstack();
new_ctx->reset_context_objects();
new_ctx->next = ctx;
ctx = new_ctx;
} }
void nest_stacks(factor_vm *parent) void begin_callback(factor_vm *parent)
{ {
return parent->nest_stacks(); parent->begin_callback();
} }
/* called when leaving a compiled callback */ void factor_vm::end_callback()
void factor_vm::unnest_stacks()
{ {
context *old_ctx = ctx; callback_ids.pop_back();
ctx = old_ctx->next; delete_context(ctx);
dealloc_context(old_ctx);
} }
void unnest_stacks(factor_vm *parent) void end_callback(factor_vm *parent)
{ {
return parent->unnest_stacks(); parent->end_callback();
} }
/* called on startup */ void factor_vm::primitive_current_callback()
void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
{ {
ds_size = ds_size_; ctx->push(tag_fixnum(callback_ids.back()));
rs_size = rs_size_;
ctx = NULL;
unused_contexts = NULL;
} }
void factor_vm::primitive_context_object() void factor_vm::primitive_context_object()
@ -126,13 +161,13 @@ bool factor_vm::stack_to_array(cell bottom, cell top)
void factor_vm::primitive_datastack() void factor_vm::primitive_datastack()
{ {
if(!stack_to_array(ctx->datastack_region->start,ctx->datastack)) if(!stack_to_array(ctx->datastack_seg->start,ctx->datastack))
general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL); general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL);
} }
void factor_vm::primitive_retainstack() void factor_vm::primitive_retainstack()
{ {
if(!stack_to_array(ctx->retainstack_region->start,ctx->retainstack)) if(!stack_to_array(ctx->retainstack_seg->start,ctx->retainstack))
general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL); general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL);
} }
@ -146,12 +181,12 @@ cell factor_vm::array_to_stack(array *array, cell bottom)
void factor_vm::primitive_set_datastack() void factor_vm::primitive_set_datastack()
{ {
ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_region->start); ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_seg->start);
} }
void factor_vm::primitive_set_retainstack() void factor_vm::primitive_set_retainstack()
{ {
ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_region->start); ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_seg->start);
} }
/* Used to implement call( */ /* Used to implement call( */
@ -162,12 +197,12 @@ void factor_vm::primitive_check_datastack()
fixnum height = out - in; fixnum height = out - in;
array *saved_datastack = untag_check<array>(ctx->pop()); array *saved_datastack = untag_check<array>(ctx->pop());
fixnum saved_height = array_capacity(saved_datastack); fixnum saved_height = array_capacity(saved_datastack);
fixnum current_height = (ctx->datastack - ctx->datastack_region->start + sizeof(cell)) / sizeof(cell); fixnum current_height = (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) / sizeof(cell);
if(current_height - height != saved_height) if(current_height - height != saved_height)
ctx->push(false_object); ctx->push(false_object);
else else
{ {
cell *ds_bot = (cell *)ctx->datastack_region->start; cell *ds_bot = (cell *)ctx->datastack_seg->start;
for(fixnum i = 0; i < saved_height - in; i++) for(fixnum i = 0; i < saved_height - in; i++)
{ {
if(ds_bot[i] != array_nth(saved_datastack,i)) if(ds_bot[i] != array_nth(saved_datastack,i))
@ -190,4 +225,22 @@ void factor_vm::primitive_load_locals()
ctx->retainstack += sizeof(cell) * count; ctx->retainstack += sizeof(cell) * count;
} }
void factor_vm::primitive_current_context()
{
ctx->push(allot_alien(ctx));
}
void factor_vm::primitive_start_context()
{
cell quot = ctx->pop();
ctx = new_context();
unwind_native_frames(quot,ctx->callstack_bottom);
}
void factor_vm::primitive_delete_context()
{
context *old_context = (context *)pinned_alien_offset(ctx->pop());
delete_context(old_context);
}
} }

36
vm/contexts.hpp
View File

@ -6,12 +6,13 @@ static const cell context_object_count = 10;
enum context_object { enum context_object {
OBJ_NAMESTACK, OBJ_NAMESTACK,
OBJ_CATCHSTACK, OBJ_CATCHSTACK,
OBJ_CONTEXT_ID,
}; };
/* Assembly code makes assumptions about the layout of this struct */
struct context { struct context {
/* C stack pointer on entry */
// First 4 fields accessed directly by compiler. See basis/vm/vm.factor
/* Factor callstack pointers */
stack_frame *callstack_top; stack_frame *callstack_top;
stack_frame *callstack_bottom; stack_frame *callstack_bottom;
@ -21,22 +22,25 @@ struct context {
/* current retain stack top pointer */ /* current retain stack top pointer */
cell retainstack; cell retainstack;
/* memory region holding current datastack */ /* C callstack pointer */
segment *datastack_region; cell callstack_save;
/* memory region holding current retain stack */
segment *retainstack_region;
/* context-specific special objects, accessed by context-object and /* context-specific special objects, accessed by context-object and
set-context-object primitives */ set-context-object primitives */
cell context_objects[context_object_count]; cell context_objects[context_object_count];
context *next; segment *datastack_seg;
segment *retainstack_seg;
segment *callstack_seg;
context(cell datastack_size, cell retainstack_size, cell callstack_size);
~context();
context(cell ds_size, cell rs_size);
void reset_datastack(); void reset_datastack();
void reset_retainstack(); void reset_retainstack();
void reset_callstack();
void reset_context_objects(); void reset_context_objects();
void reset();
cell peek() cell peek()
{ {
@ -65,17 +69,17 @@ struct context {
void fix_stacks() void fix_stacks()
{ {
if(datastack + sizeof(cell) < datastack_region->start if(datastack + sizeof(cell) < datastack_seg->start
|| datastack + stack_reserved >= datastack_region->end) || datastack + stack_reserved >= datastack_seg->end)
reset_datastack(); reset_datastack();
if(retainstack + sizeof(cell) < retainstack_region->start if(retainstack + sizeof(cell) < retainstack_seg->start
|| retainstack + stack_reserved >= retainstack_region->end) || retainstack + stack_reserved >= retainstack_seg->end)
reset_retainstack(); reset_retainstack();
} }
}; };
VM_C_API void nest_stacks(factor_vm *vm); VM_C_API void begin_callback(factor_vm *vm);
VM_C_API void unnest_stacks(factor_vm *vm); VM_C_API void end_callback(factor_vm *vm);
} }

2
vm/cpu-ppc.hpp
View File

@ -3,6 +3,8 @@ namespace factor
#define FACTOR_CPU_STRING "ppc" #define FACTOR_CPU_STRING "ppc"
#define CALLSTACK_BOTTOM(ctx) (stack_frame *)ctx->callstack_seg->end
/* In the instruction sequence: /* In the instruction sequence:
LOAD32 r3,... LOAD32 r3,...

2
vm/cpu-x86.hpp
View File

@ -5,6 +5,8 @@ namespace factor
#define FRAME_RETURN_ADDRESS(frame,vm) *(void **)(vm->frame_successor(frame) + 1) #define FRAME_RETURN_ADDRESS(frame,vm) *(void **)(vm->frame_successor(frame) + 1)
#define CALLSTACK_BOTTOM(ctx) (stack_frame *)(ctx->callstack_seg->end - sizeof(cell))
inline static void flush_icache(cell start, cell len) {} inline static void flush_icache(cell start, cell len) {}
/* In the instruction sequence: /* In the instruction sequence:

2
vm/data_heap.cpp
View File

@ -159,7 +159,7 @@ cell object::size() const
case WRAPPER_TYPE: case WRAPPER_TYPE:
return align(sizeof(wrapper),data_alignment); return align(sizeof(wrapper),data_alignment);
case CALLSTACK_TYPE: case CALLSTACK_TYPE:
return align(callstack_size(untag_fixnum(((callstack *)this)->length)),data_alignment); return align(callstack_object_size(untag_fixnum(((callstack *)this)->length)),data_alignment);
default: default:
critical_error("Invalid header",(cell)this); critical_error("Invalid header",(cell)this);
return 0; /* can't happen */ return 0; /* can't happen */

8
vm/debug.cpp
View File

@ -145,13 +145,13 @@ void factor_vm::print_objects(cell *start, cell *end)
void factor_vm::print_datastack() void factor_vm::print_datastack()
{ {
std::cout << "==== DATA STACK:\n"; std::cout << "==== DATA STACK:\n";
print_objects((cell *)ctx->datastack_region->start,(cell *)ctx->datastack); print_objects((cell *)ctx->datastack_seg->start,(cell *)ctx->datastack);
} }
void factor_vm::print_retainstack() void factor_vm::print_retainstack()
{ {
std::cout << "==== RETAIN STACK:\n"; std::cout << "==== RETAIN STACK:\n";
print_objects((cell *)ctx->retainstack_region->start,(cell *)ctx->retainstack); print_objects((cell *)ctx->retainstack_seg->start,(cell *)ctx->retainstack);
} }
struct stack_frame_printer { struct stack_frame_printer {
@ -421,9 +421,9 @@ void factor_vm::factorbug()
else if(strcmp(cmd,"t") == 0) else if(strcmp(cmd,"t") == 0)
full_output = !full_output; full_output = !full_output;
else if(strcmp(cmd,"s") == 0) else if(strcmp(cmd,"s") == 0)
dump_memory(ctx->datastack_region->start,ctx->datastack); dump_memory(ctx->datastack_seg->start,ctx->datastack);
else if(strcmp(cmd,"r") == 0) else if(strcmp(cmd,"r") == 0)
dump_memory(ctx->retainstack_region->start,ctx->retainstack); dump_memory(ctx->retainstack_seg->start,ctx->retainstack);
else if(strcmp(cmd,".s") == 0) else if(strcmp(cmd,".s") == 0)
print_datastack(); print_datastack();
else if(strcmp(cmd,".r") == 0) else if(strcmp(cmd,".r") == 0)

8
vm/errors.cpp
View File

@ -99,13 +99,13 @@ bool factor_vm::in_page(cell fault, cell area, cell area_size, int offset)
void factor_vm::memory_protection_error(cell addr, stack_frame *native_stack) void factor_vm::memory_protection_error(cell addr, stack_frame *native_stack)
{ {
if(in_page(addr, ctx->datastack_region->start, 0, -1)) if(in_page(addr, ctx->datastack_seg->start, 0, -1))
general_error(ERROR_DS_UNDERFLOW,false_object,false_object,native_stack); general_error(ERROR_DS_UNDERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, ctx->datastack_region->start, ds_size, 0)) else if(in_page(addr, ctx->datastack_seg->start, datastack_size, 0))
general_error(ERROR_DS_OVERFLOW,false_object,false_object,native_stack); general_error(ERROR_DS_OVERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, ctx->retainstack_region->start, 0, -1)) else if(in_page(addr, ctx->retainstack_seg->start, 0, -1))
general_error(ERROR_RS_UNDERFLOW,false_object,false_object,native_stack); general_error(ERROR_RS_UNDERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, ctx->retainstack_region->start, rs_size, 0)) else if(in_page(addr, ctx->retainstack_seg->start, retainstack_size, 0))
general_error(ERROR_RS_OVERFLOW,false_object,false_object,native_stack); general_error(ERROR_RS_OVERFLOW,false_object,false_object,native_stack);
else if(in_page(addr, nursery.end, 0, 0)) else if(in_page(addr, nursery.end, 0, 0))
critical_error("allot_object() missed GC check",0); critical_error("allot_object() missed GC check",0);

21
vm/factor.cpp
View File

@ -14,8 +14,9 @@ void factor_vm::default_parameters(vm_parameters *p)
{ {
p->image_path = NULL; p->image_path = NULL;
p->ds_size = 32 * sizeof(cell); p->datastack_size = 32 * sizeof(cell);
p->rs_size = 32 * sizeof(cell); p->retainstack_size = 32 * sizeof(cell);
p->callstack_size = 128 * sizeof(cell);
p->code_size = 8 * sizeof(cell); p->code_size = 8 * sizeof(cell);
p->young_size = sizeof(cell) / 4; p->young_size = sizeof(cell) / 4;
@ -59,8 +60,9 @@ void factor_vm::init_parameters_from_args(vm_parameters *p, int argc, vm_char **
{ {
vm_char *arg = argv[i]; vm_char *arg = argv[i];
if(STRCMP(arg,STRING_LITERAL("--")) == 0) break; if(STRCMP(arg,STRING_LITERAL("--")) == 0) break;
else if(factor_arg(arg,STRING_LITERAL("-datastack=%d"),&p->ds_size)); else if(factor_arg(arg,STRING_LITERAL("-datastack=%d"),&p->datastack_size));
else if(factor_arg(arg,STRING_LITERAL("-retainstack=%d"),&p->rs_size)); else if(factor_arg(arg,STRING_LITERAL("-retainstack=%d"),&p->retainstack_size));
else if(factor_arg(arg,STRING_LITERAL("-callstack=%d"),&p->callstack_size));
else if(factor_arg(arg,STRING_LITERAL("-young=%d"),&p->young_size)); else if(factor_arg(arg,STRING_LITERAL("-young=%d"),&p->young_size));
else if(factor_arg(arg,STRING_LITERAL("-aging=%d"),&p->aging_size)); else if(factor_arg(arg,STRING_LITERAL("-aging=%d"),&p->aging_size));
else if(factor_arg(arg,STRING_LITERAL("-tenured=%d"),&p->tenured_size)); else if(factor_arg(arg,STRING_LITERAL("-tenured=%d"),&p->tenured_size));
@ -91,8 +93,9 @@ void factor_vm::prepare_boot_image()
void factor_vm::init_factor(vm_parameters *p) void factor_vm::init_factor(vm_parameters *p)
{ {
/* Kilobytes */ /* Kilobytes */
p->ds_size = align_page(p->ds_size << 10); p->datastack_size = align_page(p->datastack_size << 10);
p->rs_size = align_page(p->rs_size << 10); p->retainstack_size = align_page(p->retainstack_size << 10);
p->callstack_size = align_page(p->retainstack_size << 10);
p->callback_size = align_page(p->callback_size << 10); p->callback_size = align_page(p->callback_size << 10);
/* Megabytes */ /* Megabytes */
@ -117,7 +120,7 @@ void factor_vm::init_factor(vm_parameters *p)
srand((unsigned int)system_micros()); srand((unsigned int)system_micros());
init_ffi(); init_ffi();
init_stacks(p->ds_size,p->rs_size); init_contexts(p->datastack_size,p->retainstack_size,p->callstack_size);
init_callbacks(p->callback_size); init_callbacks(p->callback_size);
load_image(p); load_image(p);
init_c_io(); init_c_io();
@ -161,16 +164,12 @@ void factor_vm::start_factor(vm_parameters *p)
{ {
if(p->fep) factorbug(); if(p->fep) factorbug();
nest_stacks();
c_to_factor_toplevel(special_objects[OBJ_STARTUP_QUOT]); c_to_factor_toplevel(special_objects[OBJ_STARTUP_QUOT]);
unnest_stacks();
} }
void factor_vm::stop_factor() void factor_vm::stop_factor()
{ {
nest_stacks();
c_to_factor_toplevel(special_objects[OBJ_SHUTDOWN_QUOT]); c_to_factor_toplevel(special_objects[OBJ_SHUTDOWN_QUOT]);
unnest_stacks();
} }
char *factor_vm::factor_eval_string(char *string) char *factor_vm::factor_eval_string(char *string)

2
vm/image.hpp
View File

@ -30,7 +30,7 @@ struct image_header {
struct vm_parameters { struct vm_parameters {
const vm_char *image_path; const vm_char *image_path;
const vm_char *executable_path; const vm_char *executable_path;
cell ds_size, rs_size; cell datastack_size, retainstack_size, callstack_size;
cell young_size, aging_size, tenured_size; cell young_size, aging_size, tenured_size;
cell code_size; cell code_size;
bool fep; bool fep;

8
vm/primitives.hpp
View File

@ -2,6 +2,7 @@ namespace factor
{ {
/* Generated with PRIMITIVE in primitives.cpp */ /* Generated with PRIMITIVE in primitives.cpp */
#define EACH_PRIMITIVE(_) \ #define EACH_PRIMITIVE(_) \
_(alien_address) \ _(alien_address) \
_(all_instances) \ _(all_instances) \
@ -43,8 +44,11 @@ namespace factor
_(compact_gc) \ _(compact_gc) \
_(compute_identity_hashcode) \ _(compute_identity_hashcode) \
_(context_object) \ _(context_object) \
_(current_callback) \
_(current_context) \
_(data_room) \ _(data_room) \
_(datastack) \ _(datastack) \
_(delete_context) \
_(die) \ _(die) \
_(disable_gc_events) \ _(disable_gc_events) \
_(dispatch_stats) \ _(dispatch_stats) \
@ -118,6 +122,7 @@ namespace factor
_(size) \ _(size) \
_(sleep) \ _(sleep) \
_(special_object) \ _(special_object) \
_(start_context) \
_(string) \ _(string) \
_(string_nth) \ _(string_nth) \
_(strip_stack_traces) \ _(strip_stack_traces) \
@ -130,9 +135,6 @@ namespace factor
_(word_code) \ _(word_code) \
_(wrapper) _(wrapper)
/* These are generated with macros in alien.cpp, and not with PRIMIIVE in
primitives.cpp */
#define EACH_ALIEN_PRIMITIVE(_) \ #define EACH_ALIEN_PRIMITIVE(_) \
_(signed_cell,fixnum,from_signed_cell,to_fixnum) \ _(signed_cell,fixnum,from_signed_cell,to_fixnum) \
_(unsigned_cell,cell,from_unsigned_cell,to_cell) \ _(unsigned_cell,cell,from_unsigned_cell,to_cell) \

14
vm/slot_visitor.hpp
View File

@ -170,15 +170,17 @@ void slot_visitor<Visitor>::visit_roots()
template<typename Visitor> template<typename Visitor>
void slot_visitor<Visitor>::visit_contexts() void slot_visitor<Visitor>::visit_contexts()
{ {
context *ctx = parent->ctx; std::set<context *>::const_iterator begin = parent->active_contexts.begin();
std::set<context *>::const_iterator end = parent->active_contexts.end();
while(ctx) while(begin != end)
{ {
visit_stack_elements(ctx->datastack_region,(cell *)ctx->datastack); context *ctx = *begin;
visit_stack_elements(ctx->retainstack_region,(cell *)ctx->retainstack);
visit_stack_elements(ctx->datastack_seg,(cell *)ctx->datastack);
visit_stack_elements(ctx->retainstack_seg,(cell *)ctx->retainstack);
visit_object_array(ctx->context_objects,ctx->context_objects + context_object_count); visit_object_array(ctx->context_objects,ctx->context_objects + context_object_count);
ctx = ctx->next; begin++;
} }
} }

6
vm/vm.cpp
View File

@ -5,6 +5,7 @@ namespace factor
factor_vm::factor_vm() : factor_vm::factor_vm() :
nursery(0,0), nursery(0,0),
callback_id(0),
c_to_factor_func(NULL), c_to_factor_func(NULL),
profiling_p(false), profiling_p(false),
gc_off(false), gc_off(false),
@ -17,4 +18,9 @@ factor_vm::factor_vm() :
primitive_reset_dispatch_stats(); primitive_reset_dispatch_stats();
} }
factor_vm::~factor_vm()
{
delete_contexts();
}
} }

50
vm/vm.hpp
View File

@ -6,11 +6,14 @@ struct code_root;
struct factor_vm struct factor_vm
{ {
// First five fields accessed directly by assembler. See vm.factor // First 5 fields accessed directly by compiler. See basis/vm/vm.factor
/* Current stacks */ /* Current context */
context *ctx; context *ctx;
/* Spare context -- for callbacks */
context *spare_ctx;
/* New objects are allocated here */ /* New objects are allocated here */
nursery_space nursery; nursery_space nursery;
@ -23,10 +26,19 @@ struct factor_vm
cell special_objects[special_object_count]; cell special_objects[special_object_count];
/* Data stack and retain stack sizes */ /* Data stack and retain stack sizes */
cell ds_size, rs_size; cell datastack_size, retainstack_size, callstack_size;
/* Pooling unused contexts to make callbacks cheaper */ /* Stack of callback IDs */
context *unused_contexts; std::vector<int> callback_ids;
/* Next callback ID */
int callback_id;
/* Pooling unused contexts to make context allocation cheaper */
std::vector<context *> unused_contexts;
/* Active contexts, for tracing by the GC */
std::set<context *> active_contexts;
/* Canonical truth value. In Factor, 't' */ /* Canonical truth value. In Factor, 't' */
cell true_object; cell true_object;
@ -96,11 +108,13 @@ struct factor_vm
u64 last_nano_count; u64 last_nano_count;
// contexts // contexts
context *alloc_context(); context *new_context();
void dealloc_context(context *old_context); void delete_context(context *old_context);
void nest_stacks(); void init_contexts(cell datastack_size_, cell retainstack_size_, cell callstack_size_);
void unnest_stacks(); void delete_contexts();
void init_stacks(cell ds_size_, cell rs_size_); void begin_callback();
void end_callback();
void primitive_current_callback();
void primitive_context_object(); void primitive_context_object();
void primitive_set_context_object(); void primitive_set_context_object();
bool stack_to_array(cell bottom, cell top); bool stack_to_array(cell bottom, cell top);
@ -111,16 +125,15 @@ struct factor_vm
void primitive_set_retainstack(); void primitive_set_retainstack();
void primitive_check_datastack(); void primitive_check_datastack();
void primitive_load_locals(); void primitive_load_locals();
void primitive_current_context();
void primitive_start_context();
void primitive_delete_context();
template<typename Iterator> void iterate_active_frames(Iterator &iter) template<typename Iterator> void iterate_active_callstacks(Iterator &iter)
{ {
context *ctx = this->ctx; std::set<context *>::const_iterator begin = active_contexts.begin();
std::set<context *>::const_iterator end = active_contexts.end();
while(ctx) while(begin != end) iterate_callstack(*begin++,iter);
{
iterate_callstack(ctx,iter);
ctx = ctx->next;
}
} }
// run // run
@ -694,6 +707,7 @@ struct factor_vm
#endif #endif
factor_vm(); factor_vm();
~factor_vm();
}; };