threads: delete old contexts immediately instead of handing them off to a 'context recycler' thread
Slava Pestov
parent
60d1a9640d
commit
fb2ecab614
|
|
@ -72,6 +72,12 @@ IN: bootstrap.x86
|
|||
jit-restore-context
|
||||
] jit-primitive jit-define
|
||||
|
||||
: jit-jump-quot ( -- )
|
||||
EAX quot-entry-point-offset [+] JMP ;
|
||||
|
||||
: jit-call-quot ( -- )
|
||||
EAX quot-entry-point-offset [+] CALL ;
|
||||
|
||||
[
|
||||
jit-load-vm
|
||||
ESP [] vm-reg MOV
|
||||
|
|
@ -92,8 +98,7 @@ IN: bootstrap.x86
|
|||
ESP ctx-reg context-callstack-bottom-offset [+] MOV
|
||||
ESP 4 ADD
|
||||
|
||||
! call the quotation
|
||||
EAX quot-entry-point-offset [+] CALL
|
||||
jit-call-quot
|
||||
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
|
|
@ -109,8 +114,8 @@ IN: bootstrap.x86
|
|||
EAX ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
]
|
||||
[ EAX quot-entry-point-offset [+] CALL ]
|
||||
[ EAX quot-entry-point-offset [+] JMP ]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ]
|
||||
\ (call) define-combinator-primitive
|
||||
|
||||
[
|
||||
|
|
@ -133,8 +138,7 @@ IN: bootstrap.x86
|
|||
jit-load-context
|
||||
jit-restore-context
|
||||
|
||||
! Call quotation
|
||||
EAX quot-entry-point-offset [+] JMP
|
||||
jit-jump-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
|
|
@ -175,8 +179,8 @@ IN: bootstrap.x86
|
|||
! Call VM
|
||||
"lazy_jit_compile" jit-call
|
||||
]
|
||||
[ EAX quot-entry-point-offset [+] CALL ]
|
||||
[ EAX quot-entry-point-offset [+] JMP ]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ]
|
||||
\ lazy-jit-compile define-combinator-primitive
|
||||
|
||||
! Inline cache miss entry points
|
||||
|
|
@ -247,8 +251,8 @@ IN: bootstrap.x86
|
|||
jit-conditional
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Threads
|
||||
: jit-set-context ( reg -- )
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Save ds, rs registers
|
||||
jit-load-vm
|
||||
jit-save-context
|
||||
|
|
@ -263,7 +267,26 @@ IN: bootstrap.x86
|
|||
! Load new ds, rs registers
|
||||
jit-restore-context ;
|
||||
|
||||
[
|
||||
: jit-set-context ( -- )
|
||||
! Load context and parameter from datastack
|
||||
EAX ds-reg [] MOV
|
||||
EAX EAX alien-offset [+] MOV
|
||||
EBX ds-reg -4 [+] MOV
|
||||
ds-reg 8 SUB
|
||||
|
||||
! Make the new context active
|
||||
EAX jit-switch-context
|
||||
|
||||
! Twiddle stack for return
|
||||
ESP 4 ADD
|
||||
|
||||
! Store parameter to datastack
|
||||
ds-reg 4 ADD
|
||||
ds-reg [] EBX MOV ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-start-context ( -- )
|
||||
! Create the new context in return-reg
|
||||
jit-load-vm
|
||||
ESP [] vm-reg MOV
|
||||
|
|
@ -274,7 +297,7 @@ IN: bootstrap.x86
|
|||
ds-reg 8 SUB
|
||||
|
||||
! Make the new context active
|
||||
EAX jit-set-context
|
||||
EAX jit-switch-context
|
||||
|
||||
! Push parameter
|
||||
EAX EBX -4 [+] MOV
|
||||
|
|
@ -283,26 +306,26 @@ IN: bootstrap.x86
|
|||
|
||||
! Jump to initial quotation
|
||||
EAX EBX [] MOV
|
||||
EAX quot-entry-point-offset [+] JMP
|
||||
] \ (start-context) define-sub-primitive
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
||||
: jit-delete-current-context ( -- )
|
||||
jit-load-vm
|
||||
jit-load-context
|
||||
ESP [] vm-reg MOV
|
||||
ESP 4 [+] ctx-reg MOV
|
||||
"delete_context" jit-call ;
|
||||
|
||||
[
|
||||
! Load context and parameter from datastack
|
||||
EAX ds-reg [] MOV
|
||||
EAX EAX alien-offset [+] MOV
|
||||
EBX ds-reg -4 [+] MOV
|
||||
ds-reg 8 SUB
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] \ (set-context-and-delete) define-sub-primitive
|
||||
|
||||
! Make the new context active
|
||||
EAX jit-set-context
|
||||
|
||||
! Twiddle stack for return
|
||||
ESP 4 ADD
|
||||
|
||||
! Store parameter to datastack
|
||||
ds-reg 4 ADD
|
||||
ds-reg [] EBX MOV
|
||||
] \ (set-context) define-sub-primitive
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-start-context
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -70,6 +70,10 @@ IN: bootstrap.x86
|
|||
jit-restore-context
|
||||
] jit-primitive jit-define
|
||||
|
||||
: jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
|
||||
|
||||
: jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
|
||||
|
||||
[
|
||||
nv-reg arg1 MOV
|
||||
|
||||
|
|
@ -87,7 +91,7 @@ IN: bootstrap.x86
|
|||
|
||||
! call the quotation
|
||||
arg1 nv-reg MOV
|
||||
arg1 quot-entry-point-offset [+] CALL
|
||||
jit-call-quot
|
||||
|
||||
jit-save-context
|
||||
|
||||
|
|
@ -102,8 +106,8 @@ IN: bootstrap.x86
|
|||
arg1 ds-reg [] MOV
|
||||
ds-reg bootstrap-cell SUB
|
||||
]
|
||||
[ arg1 quot-entry-point-offset [+] CALL ]
|
||||
[ arg1 quot-entry-point-offset [+] JMP ]
|
||||
[ jit-call-quot ]
|
||||
[ jit-jump-quot ]
|
||||
\ (call) define-combinator-primitive
|
||||
|
||||
[
|
||||
|
|
@ -124,7 +128,7 @@ IN: bootstrap.x86
|
|||
jit-restore-context
|
||||
|
||||
! Call quotation
|
||||
arg1 quot-entry-point-offset [+] JMP
|
||||
jit-jump-quot
|
||||
] \ unwind-native-frames define-sub-primitive
|
||||
|
||||
[
|
||||
|
|
@ -157,9 +161,10 @@ IN: bootstrap.x86
|
|||
jit-save-context
|
||||
arg2 vm-reg MOV
|
||||
"lazy_jit_compile" jit-call
|
||||
arg1 return-reg MOV
|
||||
]
|
||||
[ return-reg quot-entry-point-offset [+] CALL ]
|
||||
[ return-reg quot-entry-point-offset [+] JMP ]
|
||||
[ jit-jump-quot ]
|
||||
\ lazy-jit-compile define-combinator-primitive
|
||||
|
||||
! Inline cache miss entry points
|
||||
|
|
@ -222,8 +227,8 @@ IN: bootstrap.x86
|
|||
jit-conditional
|
||||
] \ fixnum* define-sub-primitive
|
||||
|
||||
! Threads
|
||||
: jit-set-context ( reg -- )
|
||||
! Contexts
|
||||
: jit-switch-context ( reg -- )
|
||||
! Save ds, rs registers
|
||||
jit-save-context
|
||||
|
||||
|
|
@ -237,44 +242,59 @@ IN: bootstrap.x86
|
|||
! Load new ds, rs registers
|
||||
jit-restore-context ;
|
||||
|
||||
[
|
||||
: jit-pop-context-and-param ( -- )
|
||||
arg1 ds-reg [] MOV
|
||||
arg1 arg1 alien-offset [+] MOV
|
||||
arg2 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB ;
|
||||
|
||||
: jit-push-param ( -- )
|
||||
ds-reg 8 ADD
|
||||
ds-reg [] arg2 MOV ;
|
||||
|
||||
: jit-set-context ( -- )
|
||||
jit-pop-context-and-param
|
||||
arg1 jit-switch-context
|
||||
RSP 8 ADD
|
||||
jit-push-param ;
|
||||
|
||||
[ jit-set-context ] \ (set-context) define-sub-primitive
|
||||
|
||||
: jit-pop-quot-and-param ( -- )
|
||||
arg1 ds-reg [] MOV
|
||||
arg2 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB ;
|
||||
|
||||
: jit-start-context ( -- )
|
||||
! Create the new context in return-reg
|
||||
arg1 vm-reg MOV
|
||||
"new_context" jit-call
|
||||
|
||||
! Load quotation and parameter from datastack
|
||||
arg1 ds-reg [] MOV
|
||||
arg2 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB
|
||||
jit-pop-quot-and-param
|
||||
|
||||
! Make the new context active
|
||||
return-reg jit-set-context
|
||||
return-reg jit-switch-context
|
||||
|
||||
! Push parameter
|
||||
ds-reg 8 ADD
|
||||
ds-reg [] arg2 MOV
|
||||
jit-push-param
|
||||
|
||||
! Jump to initial quotation
|
||||
arg1 quot-entry-point-offset [+] JMP
|
||||
] \ (start-context) define-sub-primitive
|
||||
jit-jump-quot ;
|
||||
|
||||
[ jit-start-context ] \ (start-context) define-sub-primitive
|
||||
|
||||
: jit-delete-current-context ( -- )
|
||||
jit-load-context
|
||||
arg1 vm-reg MOV
|
||||
arg2 ctx-reg MOV
|
||||
"delete_context" jit-call ;
|
||||
|
||||
[
|
||||
! Load context and parameter from datastack
|
||||
temp0 ds-reg [] MOV
|
||||
temp0 temp0 alien-offset [+] MOV
|
||||
temp1 ds-reg -8 [+] MOV
|
||||
ds-reg 16 SUB
|
||||
jit-delete-current-context
|
||||
jit-set-context
|
||||
] \ (set-context-and-delete) define-sub-primitive
|
||||
|
||||
! Make the new context active
|
||||
temp0 jit-set-context
|
||||
|
||||
! Twiddle stack for return
|
||||
RSP 8 ADD
|
||||
|
||||
! Store parameter to datastack
|
||||
ds-reg 8 ADD
|
||||
ds-reg [] temp1 MOV
|
||||
] \ (set-context) define-sub-primitive
|
||||
[
|
||||
jit-delete-current-context
|
||||
jit-start-context
|
||||
] \ (start-context-and-delete) define-sub-primitive
|
||||
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -151,13 +151,6 @@ M: bad-call summary
|
|||
: required-stack-effect ( word -- effect )
|
||||
dup stack-effect [ ] [ missing-effect ] ?if ;
|
||||
|
||||
: infer-word ( word -- )
|
||||
{
|
||||
{ [ dup macro? ] [ do-not-compile ] }
|
||||
{ [ dup "no-compile" word-prop ] [ do-not-compile ] }
|
||||
[ dup required-stack-effect apply-word/effect ]
|
||||
} cond ;
|
||||
|
||||
: with-infer ( quot -- effect visitor )
|
||||
[
|
||||
init-inference
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ compiler.units system.private combinators
|
|||
combinators.short-circuit locals locals.backend locals.types
|
||||
combinators.private stack-checker.values generic.single
|
||||
generic.single.private alien.libraries tools.dispatch.private
|
||||
tools.profiler.private
|
||||
tools.profiler.private macros
|
||||
stack-checker.alien
|
||||
stack-checker.state
|
||||
stack-checker.errors
|
||||
|
|
@ -27,11 +27,41 @@ stack-checker.recursive-state
|
|||
stack-checker.row-polymorphism ;
|
||||
IN: stack-checker.known-words
|
||||
|
||||
: infer-primitive ( word -- )
|
||||
dup
|
||||
[ "input-classes" word-prop ]
|
||||
[ "default-output-classes" word-prop ] bi <effect>
|
||||
apply-word/effect ;
|
||||
: infer-special ( word -- )
|
||||
[ current-word set ] [ "special" word-prop call( -- ) ] bi ;
|
||||
|
||||
: infer-shuffle ( shuffle -- )
|
||||
[ in>> length consume-d ] keep ! inputs shuffle
|
||||
[ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
|
||||
[ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
|
||||
#shuffle, ;
|
||||
|
||||
: infer-shuffle-word ( word -- )
|
||||
"shuffle" word-prop infer-shuffle ;
|
||||
|
||||
: infer-local-reader ( word -- )
|
||||
(( -- value )) apply-word/effect ;
|
||||
|
||||
: infer-local-writer ( word -- )
|
||||
(( value -- )) apply-word/effect ;
|
||||
|
||||
: infer-local-word ( word -- )
|
||||
"local-word-def" word-prop infer-quot-here ;
|
||||
|
||||
: non-inline-word ( word -- )
|
||||
dup depends-on-effect
|
||||
{
|
||||
{ [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
|
||||
{ [ dup "special" word-prop ] [ infer-special ] }
|
||||
{ [ dup "transform-quot" word-prop ] [ apply-transform ] }
|
||||
{ [ dup macro? ] [ apply-macro ] }
|
||||
{ [ dup local? ] [ infer-local-reader ] }
|
||||
{ [ dup local-reader? ] [ infer-local-reader ] }
|
||||
{ [ dup local-writer? ] [ infer-local-writer ] }
|
||||
{ [ dup local-word? ] [ infer-local-word ] }
|
||||
{ [ dup "no-compile" word-prop ] [ do-not-compile ] }
|
||||
[ dup required-stack-effect apply-word/effect ]
|
||||
} cond ;
|
||||
|
||||
{
|
||||
{ drop (( x -- )) }
|
||||
|
|
@ -51,15 +81,6 @@ IN: stack-checker.known-words
|
|||
{ swap (( x y -- y x )) }
|
||||
} [ "shuffle" set-word-prop ] assoc-each
|
||||
|
||||
: infer-shuffle ( shuffle -- )
|
||||
[ in>> length consume-d ] keep ! inputs shuffle
|
||||
[ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
|
||||
[ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
|
||||
#shuffle, ;
|
||||
|
||||
: infer-shuffle-word ( word -- )
|
||||
"shuffle" word-prop infer-shuffle ;
|
||||
|
||||
: check-declaration ( declaration -- declaration )
|
||||
dup { [ array? ] [ [ class? ] all? ] } 1&&
|
||||
[ bad-declaration-error ] unless ;
|
||||
|
|
@ -180,11 +201,6 @@ M: bad-executable summary
|
|||
|
||||
\ call-effect-unsafe [ infer-call-effect-unsafe ] "special" set-word-prop
|
||||
|
||||
: infer-exit ( -- )
|
||||
\ exit (( n -- * )) apply-word/effect ;
|
||||
|
||||
\ exit [ infer-exit ] "special" set-word-prop
|
||||
|
||||
: infer-load-locals ( -- )
|
||||
pop-literal nip
|
||||
consume-d dup copy-values dup output-r
|
||||
|
|
@ -249,22 +265,10 @@ M: bad-executable summary
|
|||
c-to-factor
|
||||
} [ dup '[ _ do-not-compile ] "special" set-word-prop ] each
|
||||
|
||||
: infer-special ( word -- )
|
||||
[ current-word set ] [ "special" word-prop call( -- ) ] bi ;
|
||||
|
||||
: infer-local-reader ( word -- )
|
||||
(( -- value )) apply-word/effect ;
|
||||
|
||||
: infer-local-writer ( word -- )
|
||||
(( value -- )) apply-word/effect ;
|
||||
|
||||
: infer-local-word ( word -- )
|
||||
"local-word-def" word-prop infer-quot-here ;
|
||||
|
||||
{
|
||||
declare call (call) dip 2dip 3dip curry compose
|
||||
execute (execute) call-effect-unsafe execute-effect-unsafe if
|
||||
dispatch <tuple-boa> exit load-local load-locals get-local
|
||||
dispatch <tuple-boa> load-local load-locals get-local
|
||||
drop-locals do-primitive alien-invoke alien-indirect
|
||||
alien-callback
|
||||
} [ t "no-compile" set-word-prop ] each
|
||||
|
|
@ -276,26 +280,10 @@ M: bad-executable summary
|
|||
! More words not to compile
|
||||
\ clear t "no-compile" set-word-prop
|
||||
|
||||
: non-inline-word ( word -- )
|
||||
dup depends-on-effect
|
||||
{
|
||||
{ [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
|
||||
{ [ dup "special" word-prop ] [ infer-special ] }
|
||||
{ [ dup "primitive" word-prop ] [ infer-primitive ] }
|
||||
{ [ dup "transform-quot" word-prop ] [ apply-transform ] }
|
||||
{ [ dup "macro" word-prop ] [ apply-macro ] }
|
||||
{ [ dup local? ] [ infer-local-reader ] }
|
||||
{ [ dup local-reader? ] [ infer-local-reader ] }
|
||||
{ [ dup local-writer? ] [ infer-local-writer ] }
|
||||
{ [ dup local-word? ] [ infer-local-word ] }
|
||||
[ infer-word ]
|
||||
} cond ;
|
||||
|
||||
: define-primitive ( word inputs outputs -- )
|
||||
[ 2drop t "primitive" set-word-prop ]
|
||||
[ drop "input-classes" set-word-prop ]
|
||||
[ nip "default-output-classes" set-word-prop ]
|
||||
3tri ;
|
||||
[ "input-classes" set-word-prop ]
|
||||
[ "default-output-classes" set-word-prop ]
|
||||
bi-curry* bi ;
|
||||
|
||||
! Stack effects for all primitives
|
||||
\ (byte-array) { integer } { byte-array } define-primitive \ (byte-array) make-flushable
|
||||
|
|
@ -311,8 +299,10 @@ M: bad-executable summary
|
|||
\ (save-image) { byte-array byte-array } { } define-primitive
|
||||
\ (save-image-and-exit) { byte-array byte-array } { } define-primitive
|
||||
\ (set-context) { object alien } { object } define-primitive
|
||||
\ (set-context-and-delete) { object alien } { } define-primitive
|
||||
\ (sleep) { integer } { } define-primitive
|
||||
\ (start-context) { object quotation } { object } define-primitive
|
||||
\ (start-context-and-delete) { object quotation } { } define-primitive
|
||||
\ (word) { object object object } { word } define-primitive \ (word) make-flushable
|
||||
\ <array> { integer object } { array } define-primitive \ <array> make-flushable
|
||||
\ <byte-array> { integer } { byte-array } define-primitive \ <byte-array> make-flushable
|
||||
|
|
@ -376,7 +366,6 @@ M: bad-executable summary
|
|||
\ data-room { } { byte-array } define-primitive \ data-room make-flushable
|
||||
\ datastack { } { array } define-primitive \ datastack make-flushable
|
||||
\ datastack-for { c-ptr } { array } define-primitive \ datastack-for make-flushable
|
||||
\ delete-context { c-ptr } { } define-primitive
|
||||
\ die { } { } define-primitive
|
||||
\ disable-gc-events { } { object } define-primitive
|
||||
\ dispatch-stats { } { byte-array } define-primitive
|
||||
|
|
|
|||
|
|
@ -9,13 +9,21 @@ IN: threads
|
|||
|
||||
<PRIVATE
|
||||
|
||||
! (set-context) and (start-context) are sub-primitives, but
|
||||
! we don't want them inlined into callers since their behavior
|
||||
! depends on what frames are on the callstack
|
||||
: set-context ( obj context -- obj' ) (set-context) ;
|
||||
! Wrap sub-primitives; we don't want them inlined into callers
|
||||
! since their behavior depends on what frames are on the callstack
|
||||
: set-context ( obj context -- obj' )
|
||||
(set-context) ;
|
||||
|
||||
: start-context ( obj quot: ( obj -- * ) -- obj' ) (start-context) ;
|
||||
: start-context ( obj quot: ( obj -- * ) -- obj' )
|
||||
(start-context) ;
|
||||
|
||||
: set-context-and-delete ( obj context -- * )
|
||||
(set-context-and-delete) ;
|
||||
|
||||
: start-context-and-delete ( obj quot: ( obj -- * ) -- * )
|
||||
(start-context-and-delete) ;
|
||||
|
||||
! Context introspection
|
||||
: namestack-for ( context -- namestack )
|
||||
[ 0 ] dip context-object-for ;
|
||||
|
||||
|
|
@ -159,60 +167,43 @@ DEFER: stop
|
|||
while
|
||||
drop ;
|
||||
|
||||
: start ( namestack -- obj )
|
||||
CONSTANT: [start]
|
||||
[
|
||||
set-namestack
|
||||
init-catchstack
|
||||
self quot>> call
|
||||
stop
|
||||
] start-context ;
|
||||
]
|
||||
|
||||
DEFER: next
|
||||
|
||||
: no-runnable-threads ( -- obj )
|
||||
! We should never be in a state where the only threads
|
||||
! are sleeping; the I/O wait thread is always runnable.
|
||||
! However, if it dies, we handle this case
|
||||
! semi-gracefully.
|
||||
!
|
||||
! And if sleep-time outputs f, there are no sleeping
|
||||
! threads either... so WTF.
|
||||
sleep-time {
|
||||
{ [ dup not ] [ drop die ] }
|
||||
{ [ dup 0 = ] [ drop ] }
|
||||
[ (sleep) ]
|
||||
} cond next ;
|
||||
: no-runnable-threads ( -- ) die ;
|
||||
|
||||
: (next) ( obj thread -- obj' )
|
||||
f >>state
|
||||
dup set-self
|
||||
dup runnable>>
|
||||
[ context>> box> set-context ] [ t >>runnable drop start ] if ;
|
||||
[ context>> box> set-context ]
|
||||
[ t >>runnable drop [start] start-context ] if ;
|
||||
|
||||
: next ( -- obj )
|
||||
: (stop) ( obj thread -- * )
|
||||
dup runnable>>
|
||||
[ context>> box> set-context-and-delete ]
|
||||
[ t >>runnable drop [start] start-context-and-delete ] if ;
|
||||
|
||||
: next ( -- obj thread )
|
||||
expire-sleep-loop
|
||||
run-queue dup deque-empty?
|
||||
[ drop no-runnable-threads ]
|
||||
[ pop-back dup array? [ first2 ] [ [ f ] dip ] if (next) ] if ;
|
||||
|
||||
: recycler-thread ( -- thread ) 68 special-object ;
|
||||
|
||||
: recycler-queue ( -- vector ) 69 special-object ;
|
||||
|
||||
: delete-context-later ( context -- )
|
||||
recycler-queue push recycler-thread interrupt ;
|
||||
run-queue pop-back
|
||||
dup array? [ first2 ] [ [ f ] dip ] if
|
||||
f >>state
|
||||
dup set-self ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: stop ( -- * )
|
||||
self [ exit-handler>> call( -- ) ] [ unregister-thread ] bi
|
||||
context delete-context-later next
|
||||
die 1 exit ;
|
||||
next (stop) ;
|
||||
|
||||
: suspend ( state -- obj )
|
||||
[ self ] dip >>state
|
||||
[ context ] dip context>> >box
|
||||
next ;
|
||||
next (next) ;
|
||||
|
||||
: yield ( -- ) self resume f suspend drop ;
|
||||
|
||||
|
|
@ -260,22 +251,9 @@ GENERIC: error-in-thread ( error thread -- )
|
|||
[ set-self ]
|
||||
tri ;
|
||||
|
||||
! The recycler thread deletes contexts belonging to stopped
|
||||
! threads
|
||||
|
||||
: recycler-loop ( -- )
|
||||
recycler-queue [ [ delete-context ] each ] [ delete-all ] bi
|
||||
f sleep-until
|
||||
recycler-loop ;
|
||||
|
||||
: init-recycler ( -- )
|
||||
[ recycler-loop ] "Context recycler" spawn 68 set-special-object
|
||||
V{ } clone 69 set-special-object ;
|
||||
|
||||
: init-threads ( -- )
|
||||
init-thread-state
|
||||
init-initial-thread
|
||||
init-recycler ;
|
||||
init-initial-thread ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -175,7 +175,6 @@ IN: tools.deploy.shaker
|
|||
"predicate"
|
||||
"predicate-definition"
|
||||
"predicating"
|
||||
"primitive"
|
||||
"reader"
|
||||
"reading"
|
||||
"recursive"
|
||||
|
|
|
|||
|
|
@ -370,7 +370,9 @@ tuple
|
|||
{ "fixnum>" "math.private" (( x y -- ? )) }
|
||||
{ "fixnum>=" "math.private" (( x y -- ? )) }
|
||||
{ "(set-context)" "threads.private" (( obj context -- obj' )) }
|
||||
{ "(set-context-and-delete)" "threads.private" (( obj context -- * )) }
|
||||
{ "(start-context)" "threads.private" (( obj quot -- obj' )) }
|
||||
{ "(start-context-and-delete)" "threads.private" (( obj quot -- * )) }
|
||||
} [ first3 make-sub-primitive ] each
|
||||
|
||||
! Primitive words
|
||||
|
|
@ -531,7 +533,7 @@ tuple
|
|||
{ "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) }
|
||||
{ "set-string-nth-slow" "strings.private" "primitive_set_string_nth_slow" (( ch n string -- )) }
|
||||
{ "string-nth" "strings.private" "primitive_string_nth" (( n string -- ch )) }
|
||||
{ "(exit)" "system" "primitive_exit" (( n -- )) }
|
||||
{ "(exit)" "system" "primitive_exit" (( n -- * )) }
|
||||
{ "nano-count" "system" "primitive_nano_count" (( -- ns )) }
|
||||
{ "system-micros" "system" "primitive_system_micros" (( -- us )) }
|
||||
{ "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
|
||||
|
|
@ -540,13 +542,12 @@ tuple
|
|||
{ "context-object-for" "threads.private" "primitive_context_object_for" (( n context -- obj )) }
|
||||
{ "datastack-for" "threads.private" "primitive_datastack_for" (( context -- array )) }
|
||||
{ "retainstack-for" "threads.private" "primitive_retainstack_for" (( context -- array )) }
|
||||
{ "delete-context" "threads.private" "primitive_delete_context" (( context -- )) }
|
||||
{ "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
|
||||
{ "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
|
||||
{ "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }
|
||||
{ "optimized?" "words" "primitive_optimized_p" (( word -- ? )) }
|
||||
{ "word-code" "words" "primitive_word_code" (( word -- start end )) }
|
||||
{ "(word)" "words.private" "primitive_word" (( name vocab -- word )) }
|
||||
{ "(word)" "words.private" "primitive_word" (( name vocab hashcode -- word )) }
|
||||
} [ first4 make-primitive ] each
|
||||
|
||||
! Bump build number
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! Copyright (C) 2007, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel kernel.private sequences math namespaces
|
||||
init splitting assocs system.private layouts words ;
|
||||
|
|
@ -57,4 +57,4 @@ PRIVATE>
|
|||
|
||||
: embedded? ( -- ? ) 15 special-object ;
|
||||
|
||||
: exit ( n -- ) do-shutdown-hooks (exit) ;
|
||||
: exit ( n -- * ) do-shutdown-hooks (exit) ;
|
||||
|
|
|
|||
|
|
@ -119,6 +119,11 @@ void factor_vm::delete_context(context *old_context)
|
|||
active_contexts.erase(old_context);
|
||||
}
|
||||
|
||||
VM_C_API void delete_context(factor_vm *parent, context *old_context)
|
||||
{
|
||||
parent->delete_context(old_context);
|
||||
}
|
||||
|
||||
void factor_vm::begin_callback()
|
||||
{
|
||||
ctx->reset();
|
||||
|
|
@ -185,7 +190,10 @@ cell factor_vm::datastack_to_array(context *ctx)
|
|||
{
|
||||
cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack);
|
||||
if(array == false_object)
|
||||
{
|
||||
general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
|
||||
return false_object;
|
||||
}
|
||||
else
|
||||
return array;
|
||||
}
|
||||
|
|
@ -293,10 +301,4 @@ void factor_vm::primitive_context()
|
|||
ctx->push(allot_alien(ctx));
|
||||
}
|
||||
|
||||
void factor_vm::primitive_delete_context()
|
||||
{
|
||||
context *old_context = (context *)pinned_alien_offset(ctx->pop());
|
||||
delete_context(old_context);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -70,6 +70,7 @@ struct context {
|
|||
};
|
||||
|
||||
VM_C_API context *new_context(factor_vm *parent);
|
||||
VM_C_API void delete_context(factor_vm *parent, context *old_context);
|
||||
VM_C_API void begin_callback(factor_vm *parent);
|
||||
VM_C_API void end_callback(factor_vm *parent);
|
||||
|
||||
|
|
|
|||
|
|
@ -93,9 +93,6 @@ enum special_object {
|
|||
OBJ_SLEEP_QUEUE = 66,
|
||||
|
||||
OBJ_VM_COMPILER = 67, /* version string of the compiler we were built with */
|
||||
|
||||
OBJ_RECYCLE_THREAD = 68,
|
||||
OBJ_RECYCLE_QUEUE = 69,
|
||||
};
|
||||
|
||||
/* save-image-and-exit discards special objects that are filled in on startup
|
||||
|
|
|
|||
|
|
@ -50,7 +50,6 @@ namespace factor
|
|||
_(data_room) \
|
||||
_(datastack) \
|
||||
_(datastack_for) \
|
||||
_(delete_context) \
|
||||
_(die) \
|
||||
_(disable_gc_events) \
|
||||
_(dispatch_stats) \
|
||||
|
|
|
|||
Loading…
Reference in New Issue