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
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
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
[
jit-load-context
jit-restore-context
- ! Call quotation
- EAX quot-entry-point-offset [+] JMP
+ jit-jump-quot
] \ unwind-native-frames define-sub-primitive
[
! 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
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
! 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
ds-reg 8 SUB
! Make the new context active
- EAX jit-set-context
+ EAX jit-switch-context
! Push parameter
EAX EBX -4 [+] MOV
! Jump to initial quotation
EAX EBX [] MOV
- EAX quot-entry-point-offset [+] JMP
-] \ (start-context) define-sub-primitive
+ jit-jump-quot ;
-[
- ! 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-start-context ] \ (start-context) define-sub-primitive
- ! Make the new context active
- EAX jit-set-context
+: jit-delete-current-context ( -- )
+ jit-load-vm
+ jit-load-context
+ ESP [] vm-reg MOV
+ ESP 4 [+] ctx-reg MOV
+ "delete_context" jit-call ;
- ! Twiddle stack for return
- ESP 4 ADD
+[
+ jit-delete-current-context
+ jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
- ! 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
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
! call the quotation
arg1 nv-reg MOV
- arg1 quot-entry-point-offset [+] CALL
+ jit-call-quot
jit-save-context
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
[
jit-restore-context
! Call quotation
- arg1 quot-entry-point-offset [+] JMP
+ jit-jump-quot
] \ unwind-native-frames define-sub-primitive
[
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
jit-conditional
] \ fixnum* define-sub-primitive
-! Threads
-: jit-set-context ( reg -- )
+! Contexts
+: jit-switch-context ( reg -- )
! Save ds, rs registers
jit-save-context
! 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 ;
-[
- ! 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-start-context ] \ (start-context) define-sub-primitive
- ! Make the new context active
- temp0 jit-set-context
+: jit-delete-current-context ( -- )
+ jit-load-context
+ arg1 vm-reg MOV
+ arg2 ctx-reg MOV
+ "delete_context" jit-call ;
- ! Twiddle stack for return
- RSP 8 ADD
+[
+ jit-delete-current-context
+ jit-set-context
+] \ (set-context-and-delete) define-sub-primitive
- ! 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
: 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
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
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 -- )) }
{ 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 ;
\ 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
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
! 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
\ (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
\ 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
<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 ;
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 ;
-
-: next ( -- obj )
- 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 ;
+ [ context>> box> set-context ]
+ [ t >>runnable drop [start] start-context ] if ;
-: recycler-queue ( -- vector ) 69 special-object ;
+: (stop) ( obj thread -- * )
+ dup runnable>>
+ [ context>> box> set-context-and-delete ]
+ [ t >>runnable drop [start] start-context-and-delete ] if ;
-: delete-context-later ( context -- )
- recycler-queue push recycler-thread interrupt ;
+: next ( -- obj thread )
+ expire-sleep-loop
+ 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 ;
[ 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>
"predicate"
"predicate-definition"
"predicating"
- "primitive"
"reader"
"reading"
"recursive"
{ "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
{ "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 -- )) }
{ "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
-! 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 ;
: embedded? ( -- ? ) 15 special-object ;
-: exit ( n -- ) do-shutdown-hooks (exit) ;
+: exit ( n -- * ) do-shutdown-hooks (exit) ;
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();
{
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;
}
ctx->push(allot_alien(ctx));
}
-void factor_vm::primitive_delete_context()
-{
- context *old_context = (context *)pinned_alien_offset(ctx->pop());
- delete_context(old_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);
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
_(data_room) \
_(datastack) \
_(datastack_for) \
- _(delete_context) \
_(die) \
_(disable_gc_events) \
_(dispatch_stats) \
void primitive_check_datastack();
void primitive_load_locals();
void primitive_context();
- void primitive_delete_context();
template<typename Iterator> void iterate_active_callstacks(Iterator &iter)
{
projects / factor.git / commitdiff