threads: use context-switching primitives
Slava Pestov
parent
d130f24248
commit
c7142e4281
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors ;
|
||||
IN: boxes
|
||||
|
|
@ -15,9 +15,11 @@ ERROR: box-full box ;
|
|||
|
||||
ERROR: box-empty box ;
|
||||
|
||||
: check-box ( box -- box )
|
||||
dup occupied>> [ box-empty ] unless ; inline
|
||||
|
||||
: box> ( box -- value )
|
||||
dup occupied>>
|
||||
[ [ f ] change-value f >>occupied drop ] [ box-empty ] if ;
|
||||
check-box [ f ] change-value f >>occupied drop ;
|
||||
|
||||
: ?box ( box -- value/f ? )
|
||||
dup occupied>> [ box> t ] [ drop f f ] if ;
|
||||
|
|
|
|||
|
|
@ -247,7 +247,6 @@ M: bad-executable summary
|
|||
unwind-native-frames
|
||||
lazy-jit-compile
|
||||
c-to-factor
|
||||
call-clear
|
||||
} [ dup '[ _ do-not-compile ] "special" set-word-prop ] each
|
||||
|
||||
: infer-special ( word -- )
|
||||
|
|
@ -299,466 +298,184 @@ M: bad-executable summary
|
|||
3tri ;
|
||||
|
||||
! Stack effects for all primitives
|
||||
\ fixnum< { fixnum fixnum } { object } define-primitive
|
||||
\ fixnum< make-foldable
|
||||
|
||||
\ fixnum<= { fixnum fixnum } { object } define-primitive
|
||||
\ fixnum<= make-foldable
|
||||
|
||||
\ fixnum> { fixnum fixnum } { object } define-primitive
|
||||
\ fixnum> make-foldable
|
||||
|
||||
\ fixnum>= { fixnum fixnum } { object } define-primitive
|
||||
\ fixnum>= make-foldable
|
||||
|
||||
\ eq? { object object } { object } define-primitive
|
||||
\ eq? make-foldable
|
||||
|
||||
\ bignum>fixnum { bignum } { fixnum } define-primitive
|
||||
\ bignum>fixnum make-foldable
|
||||
|
||||
\ float>fixnum { float } { fixnum } define-primitive
|
||||
\ bignum>fixnum make-foldable
|
||||
|
||||
\ fixnum>bignum { fixnum } { bignum } define-primitive
|
||||
\ fixnum>bignum make-foldable
|
||||
|
||||
\ float>bignum { float } { bignum } define-primitive
|
||||
\ float>bignum make-foldable
|
||||
|
||||
\ fixnum>float { fixnum } { float } define-primitive
|
||||
\ fixnum>float make-foldable
|
||||
|
||||
\ bignum>float { bignum } { float } define-primitive
|
||||
\ bignum>float make-foldable
|
||||
|
||||
\ (float>string) { float } { byte-array } define-primitive
|
||||
\ (float>string) make-foldable
|
||||
|
||||
\ float>bits { real } { integer } define-primitive
|
||||
\ float>bits make-foldable
|
||||
|
||||
\ double>bits { real } { integer } define-primitive
|
||||
\ double>bits make-foldable
|
||||
|
||||
\ bits>float { integer } { float } define-primitive
|
||||
\ bits>float make-foldable
|
||||
|
||||
\ bits>double { integer } { float } define-primitive
|
||||
\ bits>double make-foldable
|
||||
|
||||
\ both-fixnums? { object object } { object } define-primitive
|
||||
|
||||
\ fixnum+ { fixnum fixnum } { integer } define-primitive
|
||||
\ fixnum+ make-foldable
|
||||
|
||||
\ fixnum+fast { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum+fast make-foldable
|
||||
|
||||
\ fixnum- { fixnum fixnum } { integer } define-primitive
|
||||
\ fixnum- make-foldable
|
||||
|
||||
\ fixnum-fast { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-fast make-foldable
|
||||
|
||||
\ fixnum* { fixnum fixnum } { integer } define-primitive
|
||||
\ fixnum* make-foldable
|
||||
|
||||
\ fixnum*fast { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum*fast make-foldable
|
||||
|
||||
\ fixnum/i { fixnum fixnum } { integer } define-primitive
|
||||
\ fixnum/i make-foldable
|
||||
|
||||
\ fixnum/i-fast { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum/i-fast make-foldable
|
||||
|
||||
\ fixnum-mod { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-mod make-foldable
|
||||
|
||||
\ fixnum/mod { fixnum fixnum } { integer fixnum } define-primitive
|
||||
\ fixnum/mod make-foldable
|
||||
|
||||
\ fixnum/mod-fast { fixnum fixnum } { fixnum fixnum } define-primitive
|
||||
\ fixnum/mod-fast make-foldable
|
||||
|
||||
\ fixnum-bitand { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-bitand make-foldable
|
||||
|
||||
\ fixnum-bitor { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-bitor make-foldable
|
||||
|
||||
\ fixnum-bitxor { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-bitxor make-foldable
|
||||
|
||||
\ fixnum-bitnot { fixnum } { fixnum } define-primitive
|
||||
\ fixnum-bitnot make-foldable
|
||||
|
||||
\ fixnum-shift { fixnum fixnum } { integer } define-primitive
|
||||
\ fixnum-shift make-foldable
|
||||
|
||||
\ fixnum-shift-fast { fixnum fixnum } { fixnum } define-primitive
|
||||
\ fixnum-shift-fast make-foldable
|
||||
|
||||
\ bignum= { bignum bignum } { object } define-primitive
|
||||
\ bignum= make-foldable
|
||||
|
||||
\ bignum+ { bignum bignum } { bignum } define-primitive
|
||||
\ bignum+ make-foldable
|
||||
|
||||
\ bignum- { bignum bignum } { bignum } define-primitive
|
||||
\ bignum- make-foldable
|
||||
|
||||
\ bignum* { bignum bignum } { bignum } define-primitive
|
||||
\ bignum* make-foldable
|
||||
|
||||
\ bignum/i { bignum bignum } { bignum } define-primitive
|
||||
\ bignum/i make-foldable
|
||||
|
||||
\ bignum-mod { bignum bignum } { bignum } define-primitive
|
||||
\ bignum-mod make-foldable
|
||||
|
||||
\ bignum/mod { bignum bignum } { bignum bignum } define-primitive
|
||||
\ bignum/mod make-foldable
|
||||
|
||||
\ bignum-bitand { bignum bignum } { bignum } define-primitive
|
||||
\ bignum-bitand make-foldable
|
||||
|
||||
\ bignum-bitor { bignum bignum } { bignum } define-primitive
|
||||
\ bignum-bitor make-foldable
|
||||
|
||||
\ bignum-bitxor { bignum bignum } { bignum } define-primitive
|
||||
\ bignum-bitxor make-foldable
|
||||
|
||||
\ bignum-bitnot { bignum } { bignum } define-primitive
|
||||
\ bignum-bitnot make-foldable
|
||||
|
||||
\ bignum-shift { bignum fixnum } { bignum } define-primitive
|
||||
\ bignum-shift make-foldable
|
||||
|
||||
\ bignum< { bignum bignum } { object } define-primitive
|
||||
\ bignum< make-foldable
|
||||
|
||||
\ bignum<= { bignum bignum } { object } define-primitive
|
||||
\ bignum<= make-foldable
|
||||
|
||||
\ bignum> { bignum bignum } { object } define-primitive
|
||||
\ bignum> make-foldable
|
||||
|
||||
\ bignum>= { bignum bignum } { object } define-primitive
|
||||
\ bignum>= make-foldable
|
||||
|
||||
\ bignum-bit? { bignum integer } { object } define-primitive
|
||||
\ bignum-bit? make-foldable
|
||||
|
||||
\ bignum-log2 { bignum } { bignum } define-primitive
|
||||
\ bignum-log2 make-foldable
|
||||
|
||||
\ byte-array>bignum { byte-array } { bignum } define-primitive
|
||||
\ byte-array>bignum make-foldable
|
||||
|
||||
\ float= { float float } { object } define-primitive
|
||||
\ float= make-foldable
|
||||
|
||||
\ float+ { float float } { float } define-primitive
|
||||
\ float+ make-foldable
|
||||
|
||||
\ float- { float float } { float } define-primitive
|
||||
\ float- make-foldable
|
||||
|
||||
\ float* { float float } { float } define-primitive
|
||||
\ float* make-foldable
|
||||
|
||||
\ float/f { float float } { float } define-primitive
|
||||
\ float/f make-foldable
|
||||
|
||||
\ float-mod { float float } { float } define-primitive
|
||||
\ float-mod make-foldable
|
||||
|
||||
\ float< { float float } { object } define-primitive
|
||||
\ float< make-foldable
|
||||
|
||||
\ float<= { float float } { object } define-primitive
|
||||
\ float<= make-foldable
|
||||
|
||||
\ float> { float float } { object } define-primitive
|
||||
\ float> make-foldable
|
||||
|
||||
\ float>= { float float } { object } define-primitive
|
||||
\ float>= make-foldable
|
||||
|
||||
\ float-u< { float float } { object } define-primitive
|
||||
\ float-u< make-foldable
|
||||
|
||||
\ float-u<= { float float } { object } define-primitive
|
||||
\ float-u<= make-foldable
|
||||
|
||||
\ float-u> { float float } { object } define-primitive
|
||||
\ float-u> make-foldable
|
||||
|
||||
\ float-u>= { float float } { object } define-primitive
|
||||
\ float-u>= make-foldable
|
||||
|
||||
\ (word) { object object object } { word } define-primitive
|
||||
\ (word) make-flushable
|
||||
|
||||
\ word-code { word } { integer integer } define-primitive
|
||||
\ word-code make-flushable
|
||||
|
||||
\ current-callback { } { fixnum } define-primitive
|
||||
\ current-callback make-flushable
|
||||
|
||||
\ context { } { c-ptr } define-primitive
|
||||
\ context make-flushable
|
||||
|
||||
\ delete-context { c-ptr } { } define-primitive
|
||||
|
||||
\ (start-context) { object quotation } { object } define-primitive
|
||||
|
||||
\ (set-context) { object alien } { object } define-primitive
|
||||
|
||||
\ special-object { fixnum } { object } define-primitive
|
||||
\ special-object make-flushable
|
||||
|
||||
\ set-special-object { object fixnum } { } define-primitive
|
||||
|
||||
\ context-object { fixnum } { object } define-primitive
|
||||
\ context-object make-flushable
|
||||
|
||||
\ set-context-object { object fixnum } { } define-primitive
|
||||
|
||||
\ (exists?) { string } { object } define-primitive
|
||||
|
||||
\ minor-gc { } { } define-primitive
|
||||
|
||||
\ gc { } { } define-primitive
|
||||
|
||||
\ compact-gc { } { } define-primitive
|
||||
|
||||
\ (save-image) { byte-array byte-array } { } define-primitive
|
||||
|
||||
\ (save-image-and-exit) { byte-array byte-array } { } define-primitive
|
||||
|
||||
\ data-room { } { byte-array } define-primitive
|
||||
\ data-room make-flushable
|
||||
|
||||
\ (code-blocks) { } { array } define-primitive
|
||||
\ (code-blocks) make-flushable
|
||||
|
||||
\ code-room { } { byte-array } define-primitive
|
||||
\ code-room make-flushable
|
||||
|
||||
\ system-micros { } { integer } define-primitive
|
||||
\ system-micros make-flushable
|
||||
|
||||
\ nano-count { } { integer } define-primitive
|
||||
\ nano-count make-flushable
|
||||
|
||||
\ tag { object } { fixnum } define-primitive
|
||||
\ tag make-foldable
|
||||
|
||||
\ (byte-array) { integer } { byte-array } define-primitive \ (byte-array) make-flushable
|
||||
\ (clone) { object } { object } define-primitive \ (clone) make-flushable
|
||||
\ (code-blocks) { } { array } define-primitive \ (code-blocks) make-flushable
|
||||
\ (dlopen) { byte-array } { dll } define-primitive
|
||||
|
||||
\ (dlsym) { byte-array object } { c-ptr } define-primitive
|
||||
|
||||
\ dlclose { dll } { } define-primitive
|
||||
|
||||
\ <byte-array> { integer } { byte-array } define-primitive
|
||||
\ <byte-array> make-flushable
|
||||
|
||||
\ (byte-array) { integer } { byte-array } define-primitive
|
||||
\ (byte-array) make-flushable
|
||||
|
||||
\ <displaced-alien> { integer c-ptr } { c-ptr } define-primitive
|
||||
\ <displaced-alien> make-flushable
|
||||
|
||||
\ alien-signed-cell { c-ptr integer } { integer } define-primitive
|
||||
\ alien-signed-cell make-flushable
|
||||
|
||||
\ set-alien-signed-cell { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-unsigned-cell { c-ptr integer } { integer } define-primitive
|
||||
\ alien-unsigned-cell make-flushable
|
||||
|
||||
\ set-alien-unsigned-cell { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-signed-8 { c-ptr integer } { integer } define-primitive
|
||||
\ alien-signed-8 make-flushable
|
||||
|
||||
\ set-alien-signed-8 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-unsigned-8 { c-ptr integer } { integer } define-primitive
|
||||
\ alien-unsigned-8 make-flushable
|
||||
|
||||
\ set-alien-unsigned-8 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-signed-4 { c-ptr integer } { integer } define-primitive
|
||||
\ alien-signed-4 make-flushable
|
||||
|
||||
\ set-alien-signed-4 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-unsigned-4 { c-ptr integer } { integer } define-primitive
|
||||
\ alien-unsigned-4 make-flushable
|
||||
|
||||
\ set-alien-unsigned-4 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-signed-2 { c-ptr integer } { fixnum } define-primitive
|
||||
\ alien-signed-2 make-flushable
|
||||
|
||||
\ set-alien-signed-2 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-unsigned-2 { c-ptr integer } { fixnum } define-primitive
|
||||
\ alien-unsigned-2 make-flushable
|
||||
|
||||
\ set-alien-unsigned-2 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-signed-1 { c-ptr integer } { fixnum } define-primitive
|
||||
\ alien-signed-1 make-flushable
|
||||
|
||||
\ set-alien-signed-1 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-unsigned-1 { c-ptr integer } { fixnum } define-primitive
|
||||
\ alien-unsigned-1 make-flushable
|
||||
|
||||
\ set-alien-unsigned-1 { integer c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-float { c-ptr integer } { float } define-primitive
|
||||
\ alien-float make-flushable
|
||||
|
||||
\ set-alien-float { float c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-double { c-ptr integer } { float } define-primitive
|
||||
\ alien-double make-flushable
|
||||
|
||||
\ set-alien-double { float c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-cell { c-ptr integer } { pinned-c-ptr } define-primitive
|
||||
\ alien-cell make-flushable
|
||||
|
||||
\ set-alien-cell { c-ptr c-ptr integer } { } define-primitive
|
||||
|
||||
\ alien-address { alien } { integer } define-primitive
|
||||
\ alien-address make-flushable
|
||||
|
||||
\ slot { object fixnum } { object } define-primitive
|
||||
\ slot make-flushable
|
||||
|
||||
\ set-slot { object object fixnum } { } define-primitive
|
||||
|
||||
\ string-nth { fixnum string } { fixnum } define-primitive
|
||||
\ string-nth make-flushable
|
||||
|
||||
\ set-string-nth-slow { fixnum fixnum string } { } define-primitive
|
||||
\ set-string-nth-fast { fixnum fixnum string } { } define-primitive
|
||||
|
||||
\ resize-array { integer array } { array } define-primitive
|
||||
\ resize-array make-flushable
|
||||
|
||||
\ resize-byte-array { integer byte-array } { byte-array } define-primitive
|
||||
\ resize-byte-array make-flushable
|
||||
|
||||
\ resize-string { integer string } { string } define-primitive
|
||||
\ resize-string make-flushable
|
||||
|
||||
\ <array> { integer object } { array } define-primitive
|
||||
\ <array> make-flushable
|
||||
|
||||
\ all-instances { } { array } define-primitive
|
||||
|
||||
\ size { object } { fixnum } define-primitive
|
||||
\ size make-flushable
|
||||
|
||||
\ die { } { } define-primitive
|
||||
|
||||
\ (fopen) { byte-array byte-array } { alien } define-primitive
|
||||
|
||||
\ fgetc { alien } { object } define-primitive
|
||||
|
||||
\ fwrite { c-ptr integer alien } { } define-primitive
|
||||
|
||||
\ fputc { object alien } { } define-primitive
|
||||
|
||||
\ fread { integer alien } { object } define-primitive
|
||||
|
||||
\ fflush { alien } { } define-primitive
|
||||
|
||||
\ fseek { integer integer alien } { } define-primitive
|
||||
|
||||
\ ftell { alien } { integer } define-primitive
|
||||
|
||||
\ fclose { alien } { } define-primitive
|
||||
|
||||
\ <wrapper> { object } { wrapper } define-primitive
|
||||
\ <wrapper> make-foldable
|
||||
|
||||
\ (clone) { object } { object } define-primitive
|
||||
\ (clone) make-flushable
|
||||
|
||||
\ <string> { integer integer } { string } define-primitive
|
||||
\ <string> make-flushable
|
||||
|
||||
\ array>quotation { array } { quotation } define-primitive
|
||||
\ array>quotation make-flushable
|
||||
|
||||
\ quotation-code { quotation } { integer integer } define-primitive
|
||||
\ quotation-code make-flushable
|
||||
|
||||
\ <tuple> { tuple-layout } { tuple } define-primitive
|
||||
\ <tuple> make-flushable
|
||||
|
||||
\ datastack { } { array } define-primitive
|
||||
\ datastack make-flushable
|
||||
|
||||
\ check-datastack { array integer integer } { object } define-primitive
|
||||
\ check-datastack make-flushable
|
||||
|
||||
\ retainstack { } { array } define-primitive
|
||||
\ retainstack make-flushable
|
||||
|
||||
\ callstack { } { callstack } define-primitive
|
||||
\ callstack make-flushable
|
||||
|
||||
\ callstack>array { callstack } { array } define-primitive
|
||||
\ callstack>array make-flushable
|
||||
|
||||
\ (sleep) { integer } { } define-primitive
|
||||
|
||||
\ become { array array } { } define-primitive
|
||||
|
||||
\ innermost-frame-executing { callstack } { object } define-primitive
|
||||
|
||||
\ innermost-frame-scan { callstack } { fixnum } define-primitive
|
||||
|
||||
\ set-innermost-frame-quot { quotation callstack } { } define-primitive
|
||||
|
||||
\ dll-valid? { object } { object } define-primitive
|
||||
|
||||
\ modify-code-heap { array object object } { } define-primitive
|
||||
|
||||
\ unimplemented { } { } define-primitive
|
||||
|
||||
\ jit-compile { quotation } { } define-primitive
|
||||
|
||||
\ lookup-method { object array } { word } define-primitive
|
||||
|
||||
\ reset-dispatch-stats { } { } define-primitive
|
||||
\ dispatch-stats { } { byte-array } define-primitive
|
||||
|
||||
\ optimized? { word } { object } define-primitive
|
||||
|
||||
\ strip-stack-traces { } { } define-primitive
|
||||
|
||||
\ <callback> { integer word } { alien } define-primitive
|
||||
|
||||
\ enable-gc-events { } { } define-primitive
|
||||
\ disable-gc-events { } { object } define-primitive
|
||||
|
||||
\ profiling { object } { } define-primitive
|
||||
|
||||
\ (identity-hashcode) { object } { fixnum } define-primitive
|
||||
|
||||
\ compute-identity-hashcode { object } { } define-primitive
|
||||
|
||||
\ (exists?) { string } { object } define-primitive
|
||||
\ (exit) { integer } { } define-primitive
|
||||
|
||||
\ (float>string) { float } { byte-array } define-primitive \ (float>string) make-foldable
|
||||
\ (fopen) { byte-array byte-array } { alien } define-primitive
|
||||
\ (identity-hashcode) { object } { fixnum } define-primitive
|
||||
\ (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
|
||||
\ (sleep) { integer } { } define-primitive
|
||||
\ (start-context) { object quotation } { object } 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
|
||||
\ <callback> { integer word } { alien } define-primitive
|
||||
\ <displaced-alien> { integer c-ptr } { c-ptr } define-primitive \ <displaced-alien> make-flushable
|
||||
\ <string> { integer integer } { string } define-primitive \ <string> make-flushable
|
||||
\ <tuple> { tuple-layout } { tuple } define-primitive \ <tuple> make-flushable
|
||||
\ <wrapper> { object } { wrapper } define-primitive \ <wrapper> make-foldable
|
||||
\ alien-address { alien } { integer } define-primitive \ alien-address make-flushable
|
||||
\ alien-cell { c-ptr integer } { pinned-c-ptr } define-primitive \ alien-cell make-flushable
|
||||
\ alien-double { c-ptr integer } { float } define-primitive \ alien-double make-flushable
|
||||
\ alien-float { c-ptr integer } { float } define-primitive \ alien-float make-flushable
|
||||
\ alien-signed-1 { c-ptr integer } { fixnum } define-primitive \ alien-signed-1 make-flushable
|
||||
\ alien-signed-2 { c-ptr integer } { fixnum } define-primitive \ alien-signed-2 make-flushable
|
||||
\ alien-signed-4 { c-ptr integer } { integer } define-primitive \ alien-signed-4 make-flushable
|
||||
\ alien-signed-8 { c-ptr integer } { integer } define-primitive \ alien-signed-8 make-flushable
|
||||
\ alien-signed-cell { c-ptr integer } { integer } define-primitive \ alien-signed-cell make-flushable
|
||||
\ alien-unsigned-1 { c-ptr integer } { fixnum } define-primitive \ alien-unsigned-1 make-flushable
|
||||
\ alien-unsigned-2 { c-ptr integer } { fixnum } define-primitive \ alien-unsigned-2 make-flushable
|
||||
\ alien-unsigned-4 { c-ptr integer } { integer } define-primitive \ alien-unsigned-4 make-flushable
|
||||
\ alien-unsigned-8 { c-ptr integer } { integer } define-primitive \ alien-unsigned-8 make-flushable
|
||||
\ alien-unsigned-cell { c-ptr integer } { integer } define-primitive \ alien-unsigned-cell make-flushable
|
||||
\ all-instances { } { array } define-primitive
|
||||
\ array>quotation { array } { quotation } define-primitive \ array>quotation make-foldable
|
||||
\ become { array array } { } define-primitive
|
||||
\ bignum* { bignum bignum } { bignum } define-primitive \ bignum* make-foldable
|
||||
\ bignum+ { bignum bignum } { bignum } define-primitive \ bignum+ make-foldable
|
||||
\ bignum- { bignum bignum } { bignum } define-primitive \ bignum- make-foldable
|
||||
\ bignum-bit? { bignum integer } { object } define-primitive \ bignum-bit? make-foldable
|
||||
\ bignum-bitand { bignum bignum } { bignum } define-primitive \ bignum-bitand make-foldable
|
||||
\ bignum-bitnot { bignum } { bignum } define-primitive \ bignum-bitnot make-foldable
|
||||
\ bignum-bitor { bignum bignum } { bignum } define-primitive \ bignum-bitor make-foldable
|
||||
\ bignum-bitxor { bignum bignum } { bignum } define-primitive \ bignum-bitxor make-foldable
|
||||
\ bignum-log2 { bignum } { bignum } define-primitive \ bignum-log2 make-foldable
|
||||
\ bignum-mod { bignum bignum } { bignum } define-primitive \ bignum-mod make-foldable
|
||||
\ bignum-shift { bignum fixnum } { bignum } define-primitive \ bignum-shift make-foldable
|
||||
\ bignum/i { bignum bignum } { bignum } define-primitive \ bignum/i make-foldable
|
||||
\ bignum/mod { bignum bignum } { bignum bignum } define-primitive \ bignum/mod make-foldable
|
||||
\ bignum< { bignum bignum } { object } define-primitive \ bignum< make-foldable
|
||||
\ bignum<= { bignum bignum } { object } define-primitive \ bignum<= make-foldable
|
||||
\ bignum= { bignum bignum } { object } define-primitive \ bignum= make-foldable
|
||||
\ bignum> { bignum bignum } { object } define-primitive \ bignum> make-foldable
|
||||
\ bignum>= { bignum bignum } { object } define-primitive \ bignum>= make-foldable
|
||||
\ bignum>fixnum { bignum } { fixnum } define-primitive \ bignum>fixnum make-foldable
|
||||
\ bignum>float { bignum } { float } define-primitive \ bignum>float make-foldable
|
||||
\ bits>double { integer } { float } define-primitive \ bits>double make-foldable
|
||||
\ bits>float { integer } { float } define-primitive \ bits>float make-foldable
|
||||
\ both-fixnums? { object object } { object } define-primitive
|
||||
\ byte-array>bignum { byte-array } { bignum } define-primitive \ byte-array>bignum make-foldable
|
||||
\ callstack { } { callstack } define-primitive \ callstack make-flushable
|
||||
\ callstack-for { c-ptr } { callstack } define-primitive \ callstack make-flushable
|
||||
\ callstack>array { callstack } { array } define-primitive \ callstack>array make-flushable
|
||||
\ check-datastack { array integer integer } { object } define-primitive \ check-datastack make-flushable
|
||||
\ code-room { } { byte-array } define-primitive \ code-room make-flushable
|
||||
\ compact-gc { } { } define-primitive
|
||||
\ compute-identity-hashcode { object } { } define-primitive
|
||||
\ context { } { c-ptr } define-primitive \ context make-flushable
|
||||
\ context-object { fixnum } { object } define-primitive \ context-object make-flushable
|
||||
\ context-object-for { fixnum c-ptr } { object } define-primitive \ context-object-for make-flushable
|
||||
\ current-callback { } { fixnum } define-primitive \ current-callback 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
|
||||
\ dlclose { dll } { } define-primitive
|
||||
\ dll-valid? { object } { object } define-primitive
|
||||
\ double>bits { real } { integer } define-primitive \ double>bits make-foldable
|
||||
\ enable-gc-events { } { } define-primitive
|
||||
\ eq? { object object } { object } define-primitive \ eq? make-foldable
|
||||
\ fclose { alien } { } define-primitive
|
||||
\ fflush { alien } { } define-primitive
|
||||
\ fgetc { alien } { object } define-primitive
|
||||
\ fixnum* { fixnum fixnum } { integer } define-primitive \ fixnum* make-foldable
|
||||
\ fixnum*fast { fixnum fixnum } { fixnum } define-primitive \ fixnum*fast make-foldable
|
||||
\ fixnum+ { fixnum fixnum } { integer } define-primitive \ fixnum+ make-foldable
|
||||
\ fixnum+fast { fixnum fixnum } { fixnum } define-primitive \ fixnum+fast make-foldable
|
||||
\ fixnum- { fixnum fixnum } { integer } define-primitive \ fixnum- make-foldable
|
||||
\ fixnum-bitand { fixnum fixnum } { fixnum } define-primitive \ fixnum-bitand make-foldable
|
||||
\ fixnum-bitnot { fixnum } { fixnum } define-primitive \ fixnum-bitnot make-foldable
|
||||
\ fixnum-bitor { fixnum fixnum } { fixnum } define-primitive \ fixnum-bitor make-foldable
|
||||
\ fixnum-bitxor { fixnum fixnum } { fixnum } define-primitive \ fixnum-bitxor make-foldable
|
||||
\ fixnum-fast { fixnum fixnum } { fixnum } define-primitive \ fixnum-fast make-foldable
|
||||
\ fixnum-mod { fixnum fixnum } { fixnum } define-primitive \ fixnum-mod make-foldable
|
||||
\ fixnum-shift { fixnum fixnum } { integer } define-primitive \ fixnum-shift make-foldable
|
||||
\ fixnum-shift-fast { fixnum fixnum } { fixnum } define-primitive \ fixnum-shift-fast make-foldable
|
||||
\ fixnum/i { fixnum fixnum } { integer } define-primitive \ fixnum/i make-foldable
|
||||
\ fixnum/i-fast { fixnum fixnum } { fixnum } define-primitive \ fixnum/i-fast make-foldable
|
||||
\ fixnum/mod { fixnum fixnum } { integer fixnum } define-primitive \ fixnum/mod make-foldable
|
||||
\ fixnum/mod-fast { fixnum fixnum } { fixnum fixnum } define-primitive \ fixnum/mod-fast make-foldable
|
||||
\ fixnum< { fixnum fixnum } { object } define-primitive \ fixnum< make-foldable
|
||||
\ fixnum<= { fixnum fixnum } { object } define-primitive \ fixnum<= make-foldable
|
||||
\ fixnum> { fixnum fixnum } { object } define-primitive \ fixnum> make-foldable
|
||||
\ fixnum>= { fixnum fixnum } { object } define-primitive \ fixnum>= make-foldable
|
||||
\ fixnum>bignum { fixnum } { bignum } define-primitive \ fixnum>bignum make-foldable
|
||||
\ fixnum>float { fixnum } { float } define-primitive \ fixnum>float make-foldable
|
||||
\ float* { float float } { float } define-primitive \ float* make-foldable
|
||||
\ float+ { float float } { float } define-primitive \ float+ make-foldable
|
||||
\ float- { float float } { float } define-primitive \ float- make-foldable
|
||||
\ float-mod { float float } { float } define-primitive \ float-mod make-foldable
|
||||
\ float-u< { float float } { object } define-primitive \ float-u< make-foldable
|
||||
\ float-u<= { float float } { object } define-primitive \ float-u<= make-foldable
|
||||
\ float-u> { float float } { object } define-primitive \ float-u> make-foldable
|
||||
\ float-u>= { float float } { object } define-primitive \ float-u>= make-foldable
|
||||
\ float/f { float float } { float } define-primitive \ float/f make-foldable
|
||||
\ float< { float float } { object } define-primitive \ float< make-foldable
|
||||
\ float<= { float float } { object } define-primitive \ float<= make-foldable
|
||||
\ float= { float float } { object } define-primitive \ float= make-foldable
|
||||
\ float> { float float } { object } define-primitive \ float> make-foldable
|
||||
\ float>= { float float } { object } define-primitive \ float>= make-foldable
|
||||
\ float>bignum { float } { bignum } define-primitive \ float>bignum make-foldable
|
||||
\ float>bits { real } { integer } define-primitive \ float>bits make-foldable
|
||||
\ float>fixnum { float } { fixnum } define-primitive \ bignum>fixnum make-foldable
|
||||
\ fputc { object alien } { } define-primitive
|
||||
\ fread { integer alien } { object } define-primitive
|
||||
\ fseek { integer integer alien } { } define-primitive
|
||||
\ ftell { alien } { integer } define-primitive
|
||||
\ fwrite { c-ptr integer alien } { } define-primitive
|
||||
\ gc { } { } define-primitive
|
||||
\ innermost-frame-executing { callstack } { object } define-primitive
|
||||
\ innermost-frame-scan { callstack } { fixnum } define-primitive
|
||||
\ jit-compile { quotation } { } define-primitive
|
||||
\ lookup-method { object array } { word } define-primitive
|
||||
\ minor-gc { } { } define-primitive
|
||||
\ modify-code-heap { array object object } { } define-primitive
|
||||
\ nano-count { } { integer } define-primitive \ nano-count make-flushable
|
||||
\ optimized? { word } { object } define-primitive
|
||||
\ profiling { object } { } define-primitive
|
||||
\ quot-compiled? { quotation } { object } define-primitive
|
||||
\ quotation-code { quotation } { integer integer } define-primitive \ quotation-code make-flushable
|
||||
\ reset-dispatch-stats { } { } define-primitive
|
||||
\ resize-array { integer array } { array } define-primitive \ resize-array make-flushable
|
||||
\ resize-byte-array { integer byte-array } { byte-array } define-primitive \ resize-byte-array make-flushable
|
||||
\ resize-string { integer string } { string } define-primitive \ resize-string make-flushable
|
||||
\ retainstack { } { array } define-primitive \ retainstack make-flushable
|
||||
\ retainstack-for { c-ptr } { array } define-primitive \ retainstack-for make-flushable
|
||||
\ set-alien-cell { c-ptr c-ptr integer } { } define-primitive
|
||||
\ set-alien-double { float c-ptr integer } { } define-primitive
|
||||
\ set-alien-float { float c-ptr integer } { } define-primitive
|
||||
\ set-alien-signed-1 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-signed-2 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-signed-4 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-signed-8 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-signed-cell { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-unsigned-1 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-unsigned-2 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-unsigned-4 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-unsigned-8 { integer c-ptr integer } { } define-primitive
|
||||
\ set-alien-unsigned-cell { integer c-ptr integer } { } define-primitive
|
||||
\ set-context-object { object fixnum } { } define-primitive
|
||||
\ set-innermost-frame-quot { quotation callstack } { } define-primitive
|
||||
\ set-slot { object object fixnum } { } define-primitive
|
||||
\ set-special-object { object fixnum } { } define-primitive
|
||||
\ set-string-nth-fast { fixnum fixnum string } { } define-primitive
|
||||
\ set-string-nth-slow { fixnum fixnum string } { } define-primitive
|
||||
\ size { object } { fixnum } define-primitive \ size make-flushable
|
||||
\ slot { object fixnum } { object } define-primitive \ slot make-flushable
|
||||
\ special-object { fixnum } { object } define-primitive \ special-object make-flushable
|
||||
\ string-nth { fixnum string } { fixnum } define-primitive \ string-nth make-flushable
|
||||
\ strip-stack-traces { } { } define-primitive
|
||||
\ system-micros { } { integer } define-primitive \ system-micros make-flushable
|
||||
\ tag { object } { fixnum } define-primitive \ tag make-foldable
|
||||
\ unimplemented { } { } define-primitive
|
||||
\ word-code { word } { integer integer } define-primitive \ word-code make-flushable
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: help.markup help.syntax kernel kernel.private io
|
||||
threads.private continuations init quotations strings
|
||||
assocs heaps boxes namespaces deques dlists system ;
|
||||
threads.private init quotations strings assocs heaps boxes
|
||||
namespaces deques dlists system ;
|
||||
IN: threads
|
||||
|
||||
ARTICLE: "threads-start/stop" "Starting and stopping threads"
|
||||
|
|
@ -48,7 +48,7 @@ ARTICLE: "thread-state" "Thread-local state and variables"
|
|||
$nl
|
||||
"Global hashtable of all threads, keyed by " { $snippet "id" } ":"
|
||||
{ $subsections threads }
|
||||
"Threads have an identity independent of continuations. If a continuation is refied in one thread and then resumed in another thread, the code running in that continuation will observe a change in the value output by " { $link self } "." ;
|
||||
"Threads have an identity independent of continuations. If a continuation is reified in one thread and then reflected in another thread, the code running in that continuation will observe a change in the value output by " { $link self } "." ;
|
||||
|
||||
ARTICLE: "thread-impl" "Thread implementation"
|
||||
"Thread implementation:"
|
||||
|
|
@ -57,10 +57,8 @@ ARTICLE: "thread-impl" "Thread implementation"
|
|||
sleep-queue
|
||||
} ;
|
||||
|
||||
ARTICLE: "threads" "Lightweight co-operative threads"
|
||||
"Factor supports lightweight co-operative threads implemented on top of " { $link "continuations" } ". A thread will yield while waiting for input/output operations to complete, or when a yield has been explicitly requested."
|
||||
$nl
|
||||
"Factor threads are very lightweight. Each thread can take as little as 900 bytes of memory. This library has been tested running hundreds of thousands of simple threads."
|
||||
ARTICLE: "threads" "Co-operative threads"
|
||||
"Factor supports co-operative threads. A thread will yield while waiting for input/output operations to complete, or when a yield has been explicitly requested."
|
||||
$nl
|
||||
"Words for working with threads are in the " { $vocab-link "threads" } " vocabulary."
|
||||
{ $subsections
|
||||
|
|
@ -78,7 +76,7 @@ HELP: thread
|
|||
{ { $snippet "id" } " - a unique identifier assigned to each thread." }
|
||||
{ { $snippet "name" } " - the name passed to " { $link spawn } "." }
|
||||
{ { $snippet "quot" } " - the initial quotation passed to " { $link spawn } "." }
|
||||
{ { $snippet "continuation" } " - a " { $link box } "; if the thread is ready to run, the box holds the continuation, otherwise it is empty." }
|
||||
{ { $snippet "status" } " - a " { $link string } " indicating what the thread is waiting for, or " { $link f } ". This slot is intended to be used for debugging purposes." }
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays hashtables heaps kernel kernel.private math
|
||||
namespaces sequences vectors continuations continuations.private
|
||||
dlists assocs system combinators combinators.private init boxes
|
||||
accessors math.order deques strings quotations fry ;
|
||||
dlists assocs system combinators init boxes accessors math.order
|
||||
deques strings quotations fry ;
|
||||
IN: threads
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -13,8 +13,24 @@ IN: threads
|
|||
! 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) ;
|
||||
|
||||
: namestack-for ( context -- namestack )
|
||||
[ 0 ] dip context-object-for ;
|
||||
|
||||
: catchstack-for ( context -- catchstack )
|
||||
[ 1 ] dip context-object-for ;
|
||||
|
||||
: continuation-for ( context -- continuation )
|
||||
{
|
||||
[ datastack-for ]
|
||||
[ callstack-for ]
|
||||
[ retainstack-for ]
|
||||
[ namestack-for ]
|
||||
[ catchstack-for ]
|
||||
} cleave <continuation> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SYMBOL: initial-thread
|
||||
|
|
@ -24,7 +40,7 @@ TUPLE: thread
|
|||
{ quot callable initial: [ ] }
|
||||
{ exit-handler callable initial: [ ] }
|
||||
{ id integer }
|
||||
{ continuation box }
|
||||
{ context box }
|
||||
state
|
||||
runnable
|
||||
mailbox
|
||||
|
|
@ -34,6 +50,9 @@ sleep-entry ;
|
|||
: self ( -- thread )
|
||||
63 special-object { thread } declare ; inline
|
||||
|
||||
: thread-continuation ( thread -- continuation )
|
||||
context>> check-box value>> continuation-for ;
|
||||
|
||||
! Thread-local storage
|
||||
: tnamespace ( -- assoc )
|
||||
self variables>> ; inline
|
||||
|
|
@ -45,14 +64,11 @@ sleep-entry ;
|
|||
tnamespace set-at ;
|
||||
|
||||
: tchange ( key quot -- )
|
||||
tnamespace swap change-at ; inline
|
||||
[ tnamespace ] dip change-at ; inline
|
||||
|
||||
: threads ( -- assoc )
|
||||
64 special-object { hashtable } declare ; inline
|
||||
|
||||
: thread ( id -- thread )
|
||||
threads at ;
|
||||
|
||||
: thread-registered? ( thread -- ? )
|
||||
id>> threads key? ;
|
||||
|
||||
|
|
@ -78,23 +94,23 @@ ERROR: not-running thread ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: new-thread ( quot name class -- thread )
|
||||
new
|
||||
swap >>name
|
||||
swap >>quot
|
||||
\ thread counter >>id
|
||||
<box> >>continuation
|
||||
H{ } clone >>variables ; inline
|
||||
|
||||
: <thread> ( quot name -- thread )
|
||||
\ thread new-thread ;
|
||||
|
||||
: run-queue ( -- dlist )
|
||||
65 special-object { dlist } declare ; inline
|
||||
|
||||
: sleep-queue ( -- heap )
|
||||
66 special-object { dlist } declare ; inline
|
||||
|
||||
: new-thread ( quot name class -- thread )
|
||||
new
|
||||
swap >>name
|
||||
swap >>quot
|
||||
\ thread counter >>id
|
||||
H{ } clone >>variables
|
||||
<box> >>context ; inline
|
||||
|
||||
: <thread> ( quot name -- thread )
|
||||
\ thread new-thread ;
|
||||
|
||||
: resume ( thread -- )
|
||||
f >>state
|
||||
check-registered run-queue push-front ;
|
||||
|
|
@ -114,6 +130,13 @@ PRIVATE>
|
|||
[ sleep-queue heap-peek nip nano-count [-] ]
|
||||
} cond ;
|
||||
|
||||
: interrupt ( thread -- )
|
||||
dup state>> [
|
||||
dup sleep-entry>> [ sleep-queue heap-delete ] when*
|
||||
f >>sleep-entry
|
||||
dup resume
|
||||
] when drop ;
|
||||
|
||||
DEFER: stop
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -136,19 +159,17 @@ DEFER: stop
|
|||
while
|
||||
drop ;
|
||||
|
||||
: start ( namestack thread -- * )
|
||||
: start ( namestack -- obj )
|
||||
[
|
||||
set-self
|
||||
set-namestack
|
||||
V{ } set-catchstack
|
||||
{ } set-retainstack
|
||||
{ } set-datastack
|
||||
self quot>> [ call stop ] call-clear
|
||||
] (( namestack thread -- * )) call-effect-unsafe ;
|
||||
init-catchstack
|
||||
self quot>> call
|
||||
stop
|
||||
] start-context ;
|
||||
|
||||
DEFER: next
|
||||
|
||||
: no-runnable-threads ( -- * )
|
||||
: 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
|
||||
|
|
@ -162,31 +183,36 @@ DEFER: next
|
|||
[ (sleep) ]
|
||||
} cond next ;
|
||||
|
||||
: (next) ( arg thread -- * )
|
||||
: (next) ( obj thread -- obj' )
|
||||
f >>state
|
||||
dup set-self
|
||||
dup runnable>> [
|
||||
continuation>> box> continue-with
|
||||
] [
|
||||
t >>runnable start
|
||||
] if ;
|
||||
dup runnable>>
|
||||
[ context>> box> set-context ] [ t >>runnable drop start ] if ;
|
||||
|
||||
: next ( -- * )
|
||||
: next ( -- obj )
|
||||
expire-sleep-loop
|
||||
run-queue dup deque-empty? [
|
||||
drop no-runnable-threads
|
||||
] [
|
||||
pop-back dup array? [ first2 ] [ f swap ] if (next)
|
||||
] if ;
|
||||
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 ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: stop ( -- * )
|
||||
self [ exit-handler>> call( -- ) ] [ unregister-thread ] bi next ;
|
||||
self [ exit-handler>> call( -- ) ] [ unregister-thread ] bi
|
||||
context delete-context-later next
|
||||
die 1 exit ;
|
||||
|
||||
: suspend ( state -- obj )
|
||||
self (>>state)
|
||||
[ self continuation>> >box next ] callcc1 ; inline
|
||||
[ self ] dip >>state
|
||||
[ context ] dip context>> >box
|
||||
next ;
|
||||
|
||||
: yield ( -- ) self resume f suspend drop ;
|
||||
|
||||
|
|
@ -196,22 +222,15 @@ M: integer sleep-until
|
|||
[ self ] dip schedule-sleep "sleep" suspend drop ;
|
||||
|
||||
M: f sleep-until
|
||||
drop "interrupt" suspend drop ;
|
||||
drop "standby" suspend drop ;
|
||||
|
||||
GENERIC: sleep ( dt -- )
|
||||
|
||||
M: real sleep
|
||||
>integer nano-count + sleep-until ;
|
||||
|
||||
: interrupt ( thread -- )
|
||||
dup state>> [
|
||||
dup sleep-entry>> [ sleep-queue heap-delete ] when*
|
||||
f >>sleep-entry
|
||||
dup resume
|
||||
] when drop ;
|
||||
|
||||
: (spawn) ( thread -- )
|
||||
[ register-thread ] [ namestack swap resume-with ] bi ;
|
||||
[ register-thread ] [ [ namestack ] dip resume-with ] bi ;
|
||||
|
||||
: spawn ( quot name -- thread )
|
||||
<thread> [ (spawn) ] keep ;
|
||||
|
|
@ -228,17 +247,35 @@ GENERIC: error-in-thread ( error thread -- )
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: init-threads ( -- )
|
||||
: init-thread-state ( -- )
|
||||
H{ } clone 64 set-special-object
|
||||
<dlist> 65 set-special-object
|
||||
<min-heap> 66 set-special-object
|
||||
initial-thread global
|
||||
[ drop [ ] "Initial" <thread> ] cache
|
||||
<box> >>continuation
|
||||
<min-heap> 66 set-special-object ;
|
||||
|
||||
: init-initial-thread ( -- )
|
||||
[ ] "Initial" <thread>
|
||||
t >>runnable
|
||||
f >>state
|
||||
dup register-thread
|
||||
set-self ;
|
||||
[ initial-thread set-global ]
|
||||
[ register-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 ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: threads kernel prettyprint prettyprint.config
|
||||
io io.styles sequences assocs namespaces sorting boxes
|
||||
|
|
@ -7,7 +7,9 @@ IN: tools.threads
|
|||
|
||||
: thread. ( thread -- )
|
||||
dup id>> pprint-cell
|
||||
dup name>> over [ write-object ] with-cell
|
||||
dup name>> [
|
||||
over write-object
|
||||
] with-cell
|
||||
dup state>> [
|
||||
[ dup self eq? "running" "yield" ? ] unless*
|
||||
write
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! Copyright (C) 2005, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs calendar combinators locals
|
||||
source-files.errors colors.constants combinators.short-circuit
|
||||
|
|
@ -30,7 +30,7 @@ output history flag mailbox thread waiting token-model word-model popup ;
|
|||
drop ;
|
||||
|
||||
: interactor-continuation ( interactor -- continuation )
|
||||
thread>> continuation>> value>> ;
|
||||
thread>> thread-continuation ;
|
||||
|
||||
: interactor-busy? ( interactor -- ? )
|
||||
#! We're busy if there's no thread to resume.
|
||||
|
|
|
|||
|
|
@ -62,10 +62,7 @@ IN: ui.tools.operations
|
|||
|
||||
! Thread
|
||||
: com-thread-traceback-window ( thread -- )
|
||||
continuation>> dup occupied>>
|
||||
[ value>> traceback-window ]
|
||||
[ drop beep ]
|
||||
if ;
|
||||
thread-continuation traceback-window ;
|
||||
|
||||
[ thread? ] \ com-thread-traceback-window H{
|
||||
{ +primary+ t }
|
||||
|
|
|
|||
|
|
@ -343,7 +343,7 @@ tuple
|
|||
{ "(execute)" "kernel.private" (( word -- )) }
|
||||
{ "(call)" "kernel.private" (( quot -- )) }
|
||||
{ "unwind-native-frames" "kernel.private" (( -- )) }
|
||||
{ "set-callstack" "kernel.private" (( cs -- * )) }
|
||||
{ "set-callstack" "kernel.private" (( callstack -- * )) }
|
||||
{ "lazy-jit-compile" "kernel.private" (( -- )) }
|
||||
{ "c-to-factor" "kernel.private" (( -- )) }
|
||||
{ "slot" "slots.private" (( obj m -- value )) }
|
||||
|
|
@ -441,23 +441,22 @@ tuple
|
|||
{ "fwrite" "io.streams.c" "primitive_fwrite" (( data length alien -- )) }
|
||||
{ "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) }
|
||||
{ "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
|
||||
{ "callstack" "kernel" "primitive_callstack" (( -- cs )) }
|
||||
{ "callstack" "kernel" "primitive_callstack" (( -- callstack )) }
|
||||
{ "callstack>array" "kernel" "primitive_callstack_to_array" (( callstack -- array )) }
|
||||
{ "datastack" "kernel" "primitive_datastack" (( -- ds )) }
|
||||
{ "datastack" "kernel" "primitive_datastack" (( -- array )) }
|
||||
{ "die" "kernel" "primitive_die" (( -- )) }
|
||||
{ "retainstack" "kernel" "primitive_retainstack" (( -- rs )) }
|
||||
{ "retainstack" "kernel" "primitive_retainstack" (( -- array )) }
|
||||
{ "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" (( obj -- code )) }
|
||||
{ "become" "kernel.private" "primitive_become" (( old new -- )) }
|
||||
{ "call-clear" "kernel.private" "primitive_call_clear" (( quot -- * )) }
|
||||
{ "check-datastack" "kernel.private" "primitive_check_datastack" (( array in# out# -- ? )) }
|
||||
{ "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" (( obj -- )) }
|
||||
{ "context-object" "kernel.private" "primitive_context_object" (( n -- obj )) }
|
||||
{ "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" (( callstack -- obj )) }
|
||||
{ "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" (( callstack -- n )) }
|
||||
{ "set-context-object" "kernel.private" "primitive_set_context_object" (( obj n -- )) }
|
||||
{ "set-datastack" "kernel.private" "primitive_set_datastack" (( ds -- )) }
|
||||
{ "set-datastack" "kernel.private" "primitive_set_datastack" (( array -- )) }
|
||||
{ "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" (( n callstack -- )) }
|
||||
{ "set-retainstack" "kernel.private" "primitive_set_retainstack" (( rs -- )) }
|
||||
{ "set-retainstack" "kernel.private" "primitive_set_retainstack" (( array -- )) }
|
||||
{ "set-special-object" "kernel.private" "primitive_set_special_object" (( obj n -- )) }
|
||||
{ "special-object" "kernel.private" "primitive_special_object" (( n -- obj )) }
|
||||
{ "strip-stack-traces" "kernel.private" "primitive_strip_stack_traces" (( -- )) }
|
||||
|
|
@ -536,8 +535,12 @@ tuple
|
|||
{ "nano-count" "system" "primitive_nano_count" (( -- ns )) }
|
||||
{ "system-micros" "system" "primitive_system_micros" (( -- us )) }
|
||||
{ "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
|
||||
{ "context" "threads.private" "primitive_context" (( -- c-ptr )) }
|
||||
{ "delete-context" "threads.private" "primitive_delete_context" (( c-ptr -- )) }
|
||||
{ "callstack-for" "threads.private" "primitive_callstack_for" (( context -- array )) }
|
||||
{ "context" "threads.private" "primitive_context" (( -- context )) }
|
||||
{ "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" (( ? -- )) }
|
||||
|
|
|
|||
|
|
@ -26,28 +26,28 @@ HELP: -rot ( x y z -- z x y ) $complex-shuffle ;
|
|||
HELP: dupd ( x y -- x x y ) $complex-shuffle ;
|
||||
HELP: swapd ( x y z -- y x z ) $complex-shuffle ;
|
||||
|
||||
HELP: datastack ( -- ds )
|
||||
{ $values { "ds" array } }
|
||||
HELP: datastack ( -- array )
|
||||
{ $values { "array" array } }
|
||||
{ $description "Outputs an array containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
|
||||
|
||||
HELP: set-datastack ( ds -- )
|
||||
{ $values { "ds" array } }
|
||||
HELP: set-datastack ( array -- )
|
||||
{ $values { "array" array } }
|
||||
{ $description "Replaces the data stack contents with a copy of an array. The end of the array becomes the top of the stack." } ;
|
||||
|
||||
HELP: retainstack ( -- rs )
|
||||
{ $values { "rs" array } }
|
||||
HELP: retainstack ( -- array )
|
||||
{ $values { "array" array } }
|
||||
{ $description "Outputs an array containing a copy of the retain stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
|
||||
|
||||
HELP: set-retainstack ( rs -- )
|
||||
{ $values { "rs" array } }
|
||||
HELP: set-retainstack ( array -- )
|
||||
{ $values { "array" array } }
|
||||
{ $description "Replaces the retain stack contents with a copy of an array. The end of the array becomes the top of the stack." } ;
|
||||
|
||||
HELP: callstack ( -- cs )
|
||||
{ $values { "cs" callstack } }
|
||||
HELP: callstack ( -- callstack )
|
||||
{ $values { "callstack" callstack } }
|
||||
{ $description "Outputs a copy of the call stack contents, with the top of the stack at the end of the vector. The stack frame of the caller word is " { $emphasis "not" } " included." } ;
|
||||
|
||||
HELP: set-callstack ( cs -- * )
|
||||
{ $values { "cs" callstack } }
|
||||
HELP: set-callstack ( callstack -- * )
|
||||
{ $values { "callstack" callstack } }
|
||||
{ $description "Replaces the call stack contents. Control flow is transferred immediately to the innermost frame of the new call stack." } ;
|
||||
|
||||
HELP: clear
|
||||
|
|
@ -208,11 +208,6 @@ HELP: call
|
|||
|
||||
{ call POSTPONE: call( } related-words
|
||||
|
||||
HELP: call-clear ( quot -- * )
|
||||
{ $values { "quot" callable } }
|
||||
{ $description "Calls a quotation with an empty call stack. If the quotation returns, Factor will exit.." }
|
||||
{ $notes "Used to implement " { $link "threads" } "." } ;
|
||||
|
||||
HELP: keep
|
||||
{ $values { "x" object } { "quot" { $quotation "( ..a x -- ..b )" } } }
|
||||
{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." }
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ This means that if 'callstack' is called in tail position, we
|
|||
will have popped a necessary frame... however this word is only
|
||||
called by continuation implementation, and user code shouldn't
|
||||
be calling it at all, so we leave it as it is for now. */
|
||||
stack_frame *factor_vm::second_from_top_stack_frame()
|
||||
stack_frame *factor_vm::second_from_top_stack_frame(context *ctx)
|
||||
{
|
||||
stack_frame *frame = ctx->callstack_bottom - 1;
|
||||
while(frame >= ctx->callstack_top
|
||||
|
|
@ -54,16 +54,27 @@ stack_frame *factor_vm::second_from_top_stack_frame()
|
|||
return frame + 1;
|
||||
}
|
||||
|
||||
void factor_vm::primitive_callstack()
|
||||
cell factor_vm::capture_callstack(context *ctx)
|
||||
{
|
||||
stack_frame *top = second_from_top_stack_frame();
|
||||
stack_frame *top = second_from_top_stack_frame(ctx);
|
||||
stack_frame *bottom = ctx->callstack_bottom;
|
||||
|
||||
fixnum size = std::max((fixnum)0,(fixnum)bottom - (fixnum)top);
|
||||
|
||||
callstack *stack = allot_callstack(size);
|
||||
memcpy(stack->top(),top,size);
|
||||
ctx->push(tag<callstack>(stack));
|
||||
return tag<callstack>(stack);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_callstack()
|
||||
{
|
||||
ctx->push(capture_callstack(ctx));
|
||||
}
|
||||
|
||||
void factor_vm::primitive_callstack_for()
|
||||
{
|
||||
context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
|
||||
ctx->push(capture_callstack(other_ctx));
|
||||
}
|
||||
|
||||
code_block *factor_vm::frame_code(stack_frame *frame)
|
||||
|
|
|
|||
|
|
@ -160,31 +160,68 @@ void factor_vm::primitive_set_context_object()
|
|||
ctx->context_objects[n] = value;
|
||||
}
|
||||
|
||||
bool factor_vm::stack_to_array(cell bottom, cell top)
|
||||
void factor_vm::primitive_context_object_for()
|
||||
{
|
||||
context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
|
||||
fixnum n = untag_fixnum(ctx->pop());
|
||||
ctx->push(other_ctx->context_objects[n]);
|
||||
}
|
||||
|
||||
cell factor_vm::stack_to_array(cell bottom, cell top)
|
||||
{
|
||||
fixnum depth = (fixnum)(top - bottom + sizeof(cell));
|
||||
|
||||
if(depth < 0)
|
||||
return false;
|
||||
return false_object;
|
||||
else
|
||||
{
|
||||
array *a = allot_uninitialized_array<array>(depth / sizeof(cell));
|
||||
memcpy(a + 1,(void*)bottom,depth);
|
||||
ctx->push(tag<array>(a));
|
||||
return true;
|
||||
return tag<array>(a);
|
||||
}
|
||||
}
|
||||
|
||||
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);
|
||||
else
|
||||
return array;
|
||||
}
|
||||
|
||||
void factor_vm::primitive_datastack()
|
||||
{
|
||||
if(!stack_to_array(ctx->datastack_seg->start,ctx->datastack))
|
||||
general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
|
||||
ctx->push(datastack_to_array(ctx));
|
||||
}
|
||||
|
||||
void factor_vm::primitive_datastack_for()
|
||||
{
|
||||
context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
|
||||
ctx->push(datastack_to_array(other_ctx));
|
||||
}
|
||||
|
||||
cell factor_vm::retainstack_to_array(context *ctx)
|
||||
{
|
||||
cell array = stack_to_array(ctx->retainstack_seg->start,ctx->retainstack);
|
||||
if(array == false_object)
|
||||
{
|
||||
general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object);
|
||||
return false_object;
|
||||
}
|
||||
else
|
||||
return array;
|
||||
}
|
||||
|
||||
void factor_vm::primitive_retainstack()
|
||||
{
|
||||
if(!stack_to_array(ctx->retainstack_seg->start,ctx->retainstack))
|
||||
general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object);
|
||||
ctx->push(retainstack_to_array(ctx));
|
||||
}
|
||||
|
||||
void factor_vm::primitive_retainstack_for()
|
||||
{
|
||||
context *other_ctx = (context *)pinned_alien_offset(ctx->pop());
|
||||
ctx->push(retainstack_to_array(other_ctx));
|
||||
}
|
||||
|
||||
/* returns pointer to top of stack */
|
||||
|
|
@ -195,14 +232,24 @@ cell factor_vm::array_to_stack(array *array, cell bottom)
|
|||
return bottom + depth - sizeof(cell);
|
||||
}
|
||||
|
||||
void factor_vm::set_datastack(context *ctx, array *array)
|
||||
{
|
||||
ctx->datastack = array_to_stack(array,ctx->datastack_seg->start);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_set_datastack()
|
||||
{
|
||||
ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_seg->start);
|
||||
set_datastack(ctx,untag_check<array>(ctx->pop()));
|
||||
}
|
||||
|
||||
void factor_vm::set_retainstack(context *ctx, array *array)
|
||||
{
|
||||
ctx->retainstack = array_to_stack(array,ctx->retainstack_seg->start);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_set_retainstack()
|
||||
{
|
||||
ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_seg->start);
|
||||
set_retainstack(ctx,untag_check<array>(ctx->pop()));
|
||||
}
|
||||
|
||||
/* Used to implement call( */
|
||||
|
|
|
|||
|
|
@ -120,11 +120,6 @@ void factor_vm::fp_trap_error(unsigned int fpu_status, stack_frame *stack)
|
|||
general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),false_object,stack);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_call_clear()
|
||||
{
|
||||
unwind_native_frames(ctx->pop(),ctx->callstack_bottom);
|
||||
}
|
||||
|
||||
/* For testing purposes */
|
||||
void factor_vm::primitive_unimplemented()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -93,6 +93,9 @@ 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
|
||||
|
|
|
|||
|
|
@ -33,9 +33,9 @@ namespace factor
|
|||
_(bits_float) \
|
||||
_(byte_array) \
|
||||
_(byte_array_to_bignum) \
|
||||
_(call_clear) \
|
||||
_(callback) \
|
||||
_(callstack) \
|
||||
_(callstack_for) \
|
||||
_(callstack_to_array) \
|
||||
_(check_datastack) \
|
||||
_(clone) \
|
||||
|
|
@ -45,9 +45,11 @@ namespace factor
|
|||
_(compute_identity_hashcode) \
|
||||
_(context) \
|
||||
_(context_object) \
|
||||
_(context_object_for) \
|
||||
_(current_callback) \
|
||||
_(data_room) \
|
||||
_(datastack) \
|
||||
_(datastack_for) \
|
||||
_(delete_context) \
|
||||
_(die) \
|
||||
_(disable_gc_events) \
|
||||
|
|
@ -109,6 +111,7 @@ namespace factor
|
|||
_(resize_byte_array) \
|
||||
_(resize_string) \
|
||||
_(retainstack) \
|
||||
_(retainstack_for) \
|
||||
_(save_image) \
|
||||
_(save_image_and_exit) \
|
||||
_(set_context_object) \
|
||||
|
|
|
|||
16
vm/vm.hpp
16
vm/vm.hpp
|
|
@ -119,12 +119,19 @@ struct factor_vm
|
|||
void end_callback();
|
||||
void primitive_current_callback();
|
||||
void primitive_context_object();
|
||||
void primitive_context_object_for();
|
||||
void primitive_set_context_object();
|
||||
bool stack_to_array(cell bottom, cell top);
|
||||
cell array_to_stack(array *array, cell bottom);
|
||||
cell stack_to_array(cell bottom, cell top);
|
||||
cell datastack_to_array(context *ctx);
|
||||
void primitive_datastack();
|
||||
void primitive_datastack_for();
|
||||
cell retainstack_to_array(context *ctx);
|
||||
void primitive_retainstack();
|
||||
void primitive_retainstack_for();
|
||||
cell array_to_stack(array *array, cell bottom);
|
||||
void set_datastack(context *ctx, array *array);
|
||||
void primitive_set_datastack();
|
||||
void set_retainstack(context *ctx, array *array);
|
||||
void primitive_set_retainstack();
|
||||
void primitive_check_datastack();
|
||||
void primitive_load_locals();
|
||||
|
|
@ -172,7 +179,6 @@ struct factor_vm
|
|||
void signal_error(cell signal, stack_frame *stack);
|
||||
void divide_by_zero_error();
|
||||
void fp_trap_error(unsigned int fpu_status, stack_frame *stack);
|
||||
void primitive_call_clear();
|
||||
void primitive_unimplemented();
|
||||
void memory_signal_handler_impl();
|
||||
void misc_signal_handler_impl();
|
||||
|
|
@ -586,8 +592,10 @@ struct factor_vm
|
|||
void check_frame(stack_frame *frame);
|
||||
callstack *allot_callstack(cell size);
|
||||
stack_frame *fix_callstack_top(stack_frame *top);
|
||||
stack_frame *second_from_top_stack_frame();
|
||||
stack_frame *second_from_top_stack_frame(context *ctx);
|
||||
cell capture_callstack(context *ctx);
|
||||
void primitive_callstack();
|
||||
void primitive_callstack_for();
|
||||
code_block *frame_code(stack_frame *frame);
|
||||
code_block_type frame_type(stack_frame *frame);
|
||||
cell frame_executing(stack_frame *frame);
|
||||
|
|
|
|||
Loading…
Reference in New Issue