(yield) renamed to stop

cvs
Slava Pestov 2005-04-22 04:22:36 +00:00
parent 4f7d80af74
commit 8b61c03fa1
15 changed files with 40 additions and 51 deletions

View File

@ -218,7 +218,7 @@ END-STRUCT
over sqlite3_step step-complete? [
2drop
] [
2dup 2slip sqlite-each
[ call ] 2keep sqlite-each
] ifte ;
! For comparison, here is the linrec implementation of sqlite-each

View File

@ -79,7 +79,7 @@ Some macros for working with tagged cells are provided:
- RETAG(cell,tag) -- set the tag of a cell
- untag_fixnum_fast(cell) -- shift the cell to the left by three bits,
- untag_fixnum_fast(cell) -- shift the cell to the right by three bits,
without actually checking that the tag is FIXNUM_TYPE. If it is not
FIXNUM_TYPE, a meaningless value is returned.

View File

@ -32,7 +32,7 @@ USE: kernel
USE: win32-io-internals
USE: win32-api
: (yield) ( -- )
: stop ( -- )
next-thread [
call
] [

View File

@ -75,7 +75,7 @@ PREDICATE: general-list list ( list -- ? )
swap [ with rot ] all? 2nip ; inline
: (each) ( list quot -- list quot )
>r uncons r> tuck 2slip ; inline
[ >r car r> call ] 2keep >r cdr r> ; inline
: each ( list quot -- )
#! Push each element of a proper list in turn, and apply a

View File

@ -5,13 +5,10 @@ IN: kernel
: slip ( quot x -- x | quot: -- )
>r call r> ; inline
: 2slip ( quot x y -- x y : quot: -- )
>r >r call r> r> ; inline
: keep ( a quot -- a | quot: a -- )
: keep ( x quot -- x | quot: x -- )
over >r call r> ; inline
: 2keep ( a b quot -- a b | quot: a b -- )
: 2keep ( x y quot -- x y | quot: x y -- )
over >r pick >r call r> r> ; inline
: while ( quot generator -- )
@ -23,7 +20,7 @@ IN: kernel
r> 2drop r> r> 2drop
] ifte ; inline
: ifte* ( cond true false -- )
: ifte* ( cond true false -- | true: cond -- | false: -- )
#! [ X ] [ Y ] ifte* ==> dup [ X ] [ drop Y ] ifte
pick [ drop call ] [ 2nip call ] ifte ; inline
@ -35,35 +32,23 @@ IN: kernel
drop r> drop r> call
] ifte ; inline
: unless ( cond quot -- )
: unless ( cond quot -- | quot: -- )
#! Execute a quotation only when the condition is f. The
#! condition is popped off the stack.
#!
#! In order to compile, the quotation must consume as many
#! values as it produces.
[ ] swap ifte ; inline
: unless* ( cond quot -- )
: unless* ( cond quot -- | quot: -- )
#! If cond is f, pop it off the stack and evaluate the
#! quotation. Otherwise, leave cond on the stack.
#!
#! In order to compile, the quotation must consume one less
#! value than it produces.
over [ drop ] [ nip call ] ifte ; inline
: when ( cond quot -- )
: when ( cond quot -- | quot: -- )
#! Execute a quotation only when the condition is not f. The
#! condition is popped off the stack.
#!
#! In order to compile, the quotation must consume as many
#! values as it produces.
[ ] ifte ; inline
: when* ( cond quot -- )
: when* ( cond quot -- | quot: cond -- )
#! If the condition is true, it is left on the stack, and
#! the quotation is evaluated. Otherwise, the condition is
#! popped off the stack.
#!
#! In order to compile, the quotation must consume one more
#! value than it produces.
dupd [ drop ] ifte ; inline

View File

@ -14,5 +14,5 @@ IN: threads USING: errors io-internals kernel lists ;
[ ] set-catchstack
{ } set-callstack
try
(yield)
stop
] callcc0 drop ;

View File

@ -9,7 +9,7 @@ BUILTIN: port 14 ;
: stdout 1 getenv ;
: blocking-flush ( port -- )
[ add-write-io-task (yield) ] callcc0 drop ;
[ add-write-io-task stop ] callcc0 drop ;
: wait-to-write ( len port -- )
tuck can-write? [ drop ] [ blocking-flush ] ifte ;
@ -20,7 +20,7 @@ BUILTIN: port 14 ;
over wait-to-write write-fd-8 ;
: blocking-fill ( port -- )
[ add-read-line-io-task (yield) ] callcc0 drop ;
[ add-read-line-io-task stop ] callcc0 drop ;
: wait-to-read-line ( port -- )
dup can-read-line? [ drop ] [ blocking-fill ] ifte ;
@ -29,7 +29,7 @@ BUILTIN: port 14 ;
dup wait-to-read-line read-line-fd-8 dup [ sbuf>string ] when ;
: fill-fd ( count port -- )
[ add-read-count-io-task (yield) ] callcc0 2drop ;
[ add-read-count-io-task stop ] callcc0 2drop ;
: wait-to-read ( count port -- )
2dup can-read-count? [ 2drop ] [ fill-fd ] ifte ;
@ -38,11 +38,11 @@ BUILTIN: port 14 ;
2dup wait-to-read read-count-fd-8 dup [ sbuf>string ] when ;
: wait-to-accept ( socket -- )
[ add-accept-io-task (yield) ] callcc0 drop ;
[ add-accept-io-task stop ] callcc0 drop ;
: blocking-accept ( socket -- host port in out )
dup wait-to-accept accept-fd ;
: blocking-copy ( in out -- )
[ add-copy-io-task (yield) ] callcc0
[ add-copy-io-task stop ] callcc0
pending-io-error pending-io-error ;

View File

@ -36,8 +36,8 @@ M: object clone ;
rot [ drop ] [ nip ] ifte ; inline
: >boolean t f ? ; inline
: not ( a -- ~a ) f t ? ; inline
: and ( a b -- a&b ) f ? ; inline
: not ( a -- ~a ) f t ? ; inline
: or ( a b -- a|b ) t swap ? ; inline
: xor ( a b -- a^b ) dup not swap ? ; inline

View File

@ -20,23 +20,18 @@ USING: io-internals kernel kernel-internals lists namespaces ;
: schedule-thread ( quot -- ) run-queue enque set-run-queue ;
: (yield) ( -- )
: stop ( -- )
#! If there is a quotation in the run queue, call it,
#! otherwise wait for I/O. The currently executing
#! continuation is suspended. Use yield instead.
#! otherwise wait for I/O.
next-thread [
call
] [
next-io-task [
call
] [
(yield)
] ifte*
next-io-task [ call ] [ stop ] ifte*
] ifte* ;
: yield ( -- )
#! Add the current continuation to the run queue, and yield
#! to the next quotation. The current continuation will
#! eventually be restored by a future call to (yield) or
#! eventually be restored by a future call to stop or
#! yield.
[ schedule-thread (yield) ] callcc0 ;
[ schedule-thread stop ] callcc0 ;

View File

@ -38,7 +38,17 @@ parser ;
#! specializing on this class.
[
"methods" word-prop [ dupd hash ] [ f ] ifte*
] word-subset word-sort nip ;
] word-subset nip ;
: classes ( -- list )
[ metaclass ] word-subset ;
: constructors ( -- list )
[
word-name dup "<" string-head? swap ">" string-tail? and
] word-subset ;
: predicates ( -- list )
[
word-name dup "?" = not swap "?" string-tail? and
] word-subset ;

View File

@ -48,6 +48,5 @@ C: dialog ( content -- gadget )
#! when the user clicks OK or Cancel. If they click Cancel,
#! push f.
[
<input-dialog> "Input" <tile> world get add-gadget
(yield)
<input-dialog> "Input" <tile> world get add-gadget stop
] callcc1 ;

View File

@ -69,7 +69,7 @@ M: pane stream-flush ( stream -- ) relayout ;
M: pane stream-auto-flush ( stream -- ) relayout ;
M: pane stream-readln ( stream -- line )
[ swap set-pane-continuation (yield) ] callcc1 nip ;
[ swap set-pane-continuation stop ] callcc1 nip ;
M: pane stream-write-attr ( string style stream -- )
[ nip swap "\n" split pane-write ] keep scroll>bottom ;

View File

@ -29,7 +29,7 @@ SYMBOL: vocabularies
: word-subset ( pred -- list | pred: word -- ? )
#! A list of words matching the predicate.
all-words swap subset ; inline
all-words swap subset word-sort ; inline
: word-subset-with ( obj pred -- list | pred: obj word -- ? )
all-words swap subset-with ; inline

View File

@ -93,7 +93,7 @@ M: win32-server accept ( server -- client )
[
alloc-io-task init-overlapped >r >r >r socket get r> r>
buffer-ptr <alien> 0 32 32 NULL r> AcceptEx
[ handle-socket-error ] unless (yield)
[ handle-socket-error ] unless stop
] callcc1 pending-error drop
swap dup add-completion <win32-stream> dupd <win32-client-stream>
swap buffer-free

View File

@ -55,7 +55,7 @@ SYMBOL: file-size
[
alloc-io-task init-overlapped >r
handle get out-buffer get [ buffer@ ] keep buffer-length
NULL r> WriteFile [ handle-io-error ] unless (yield)
NULL r> WriteFile [ handle-io-error ] unless stop
] callcc1 pending-error
dup update-file-pointer
@ -84,7 +84,7 @@ M: string do-write ( str -- )
handle get in-buffer get [ buffer@ ] keep
buffer-capacity file-size get [ fileptr get - min ] when*
NULL r>
ReadFile [ handle-io-error ] unless (yield)
ReadFile [ handle-io-error ] unless stop
] callcc1 pending-error
dup in-buffer get >buffer update-file-pointer ;