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

Fix scoping problem in cont-responder

slava 2006-04-28 01:36:29 +00:00
parent 7f79de6d1f
commit b64cb2cb75
2 changed files with 261 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

510
contrib/httpd/cont-responder.factor
View File

@ -1,29 +1,10 @@
! Copyright (C) 2004 Chris Double. ! Copyright (C) 2004 Chris Double.
! ! See http://factorcode.org/license.txt for BSD license.
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cont-responder
USING: http httpd math namespaces io USING: http httpd math namespaces io
lists strings kernel html hashtables lists strings kernel html hashtables
parser generic sequences ; parser generic sequences ;
IN: cont-responder
#! Used inside the session state of responders to indicate whether the #! Used inside the session state of responders to indicate whether the
#! next request should use the post-refresh-get pattern. It is set to #! next request should use the post-refresh-get pattern. It is set to
@ -31,95 +12,95 @@ USING: http httpd math namespaces io
SYMBOL: post-refresh-get? SYMBOL: post-refresh-get?
: expiry-timeout ( -- timeout-seconds ) : expiry-timeout ( -- timeout-seconds )
#! Number of seconds to timeout continuations in #! Number of seconds to timeout continuations in
#! continuation table. This value will need to be #! continuation table. This value will need to be
#! tuned. I leave it at 24 hours but it can be #! tuned. I leave it at 24 hours but it can be
#! higher/lower as needed. Default to 15 minutes for #! higher/lower as needed. Default to 15 minutes for
#! testing. #! testing.
900 ; 900 ;
: get-random-id ( -- id ) : get-random-id ( -- id )
#! Generate a random id to use for continuation URL's #! Generate a random id to use for continuation URL's
[ "ID" % 32 [ 9 random-int CHAR: 0 + , ] times ] "" make ; [ "ID" % 32 [ 9 random-int CHAR: 0 + , ] times ] "" make ;
SYMBOL: table SYMBOL: table
: continuation-table ( -- <hashtable> ) : continuation-table ( -- <hashtable> )
#! Return the global table of continuations #! Return the global table of continuations
table global hash ; table get-global ;
: reset-continuation-table ( -- ) : reset-continuation-table ( -- )
#! Create the initial global table #! Create the initial global table
continuation-table clear-hash ; continuation-table clear-hash ;
H{ } clone table global set-hash H{ } clone table set-global
#! Tuple for holding data related to a continuation. #! Tuple for holding data related to a continuation.
TUPLE: item expire? quot id time-added ; TUPLE: item expire? quot id time-added ;
: continuation-item ( expire? quot id -- <item> ) : continuation-item ( expire? quot id -- <item> )
#! A continuation item is the actual item stored #! A continuation item is the actual item stored
#! in the continuation table. It contains the id, #! in the continuation table. It contains the id,
#! quotation/continuation, time added, etc. If #! quotation/continuation, time added, etc. If
#! expire? is true then the continuation will #! expire? is true then the continuation will
#! be expired after a certain amount of time. #! be expired after a certain amount of time.
millis <item> ; millis <item> ;
: seconds>millis ( seconds -- millis ) : seconds>millis ( seconds -- millis )
#! Convert a number of seconds to milliseconds #! Convert a number of seconds to milliseconds
1000 * ; 1000 * ;
: expired? ( timeout-seconds <item> -- bool ) : expired? ( timeout-seconds <item> -- bool )
#! Return true if the continuation item is expirable #! Return true if the continuation item is expirable
#! and has expired (ie. was added to the table more than #! and has expired (ie. was added to the table more than
#! timeout milliseconds ago). #! timeout milliseconds ago).
[ item-time-added swap seconds>millis + millis - 0 < ] keep item-expire? and ; [ item-time-added swap seconds>millis + millis - 0 < ] keep item-expire? and ;
: expire-continuations ( timeout-seconds -- ) : expire-continuations ( timeout-seconds -- )
#! Expire all continuations in the continuation table #! Expire all continuations in the continuation table
#! if they are 'timeout-seconds' old (ie. were added #! if they are 'timeout-seconds' old (ie. were added
#! more than 'timeout-seconds' ago. #! more than 'timeout-seconds' ago.
continuation-table clone [ ( timeout-seconds [[ id item ]] -- ) continuation-table clone [
swapd expired? [ swapd expired? [
continuation-table remove-hash continuation-table remove-hash
] [ ] [
drop drop
] if ] if
] hash-each-with ; ] hash-each-with ;
: expirable ( quot -- t quot ) : expirable ( quot -- t quot )
#! Set the stack up for a register-continuation call #! Set the stack up for a register-continuation call
#! so that the given quotation is registered that it can #! so that the given quotation is registered that it can
#! be expired. #! be expired.
t swap ; t swap ;
: permanent ( quot -- f quot ) : permanent ( quot -- f quot )
#! Set the stack up for a register-continuation call #! Set the stack up for a register-continuation call
#! so that the given quotation is never expired after #! so that the given quotation is never expired after
#! registration. #! registration.
f swap ; f swap ;
: register-continuation ( expire? quot -- id ) : register-continuation ( expire? quot -- id )
#! Store a continuation in the table and associate it with #! Store a continuation in the table and associate it with
#! a random id. That continuation will be expired after #! a random id. That continuation will be expired after
#! a certain period of time if 'expire?' is true. #! a certain period of time if 'expire?' is true.
get-random-id get-random-id
[ continuation-item ] keep ( item id -- ) [ continuation-item ] keep ( item id -- )
[ continuation-table set-hash ] keep ; [ continuation-table set-hash ] keep ;
: register-continuation* ( expire? quots -- id ) : register-continuation* ( expire? quots -- id )
#! Like register-continuation but registers a quotation #! Like register-continuation but registers a quotation
#! that will call all quotations in the list, in the order given. #! that will call all quotations in the list, in the order given.
concat register-continuation ; concat register-continuation ;
: get-continuation-item ( id -- <item> ) : get-continuation-item ( id -- <item> )
#! Get the continuation item associated with the id. #! Get the continuation item associated with the id.
continuation-table hash ; continuation-table hash ;
: id>url ( id -- string ) : id>url ( id -- string )
#! Convert the continuation id to an URL suitable for #! Convert the continuation id to an URL suitable for
#! embedding in an HREF or other HTML. #! embedding in an HREF or other HTML.
url-encode "?id=" swap append ; url-encode "?id=" swap append ;
DEFER: show-final DEFER: show-final
DEFER: show DEFER: show
@ -127,257 +108,262 @@ DEFER: show
TUPLE: resume value stdio ; TUPLE: resume value stdio ;
: (expired-page-handler) ( alist -- ) : (expired-page-handler) ( alist -- )
#! Display a page has expired message. #! Display a page has expired message.
#! TODO: Need to handle this better to enable #! TODO: Need to handle this better to enable
#! returning back to root continuation. #! returning back to root continuation.
<html> <html>
<body> <body>
<p> "This page has expired." write </p> <p> "This page has expired." write </p>
</body> </body>
</html> flush ; </html> flush ;
: expired-page-handler ( alist -- ) : expired-page-handler ( alist -- )
[ (expired-page-handler) ] show-final ; [ (expired-page-handler) ] show-final ;
: >callable ( quot|interp|f -- interp ) : >callable ( quot|interp|f -- interp )
dup continuation? [ dup continuation? [
[ continue-with ] cons [ continue-with ] cons
] when ; ] when ;
: get-registered-continuation ( id -- cont ) : get-registered-continuation ( id -- cont )
#! Return the continuation or quotation #! Return the continuation or quotation
#! associated with the given id. #! associated with the given id.
#! TODO: handle expired pages better. #! TODO: handle expired pages better.
expiry-timeout expire-continuations expiry-timeout expire-continuations
get-continuation-item [ get-continuation-item [
item-quot item-quot
] [ ] [
[ (expired-page-handler) ] [ (expired-page-handler) ]
] if* >callable ; ] if* >callable ;
: resume-continuation ( resumed-data id -- ) : resume-continuation ( resumed-data id -- )
#! Call the continuation associated with the given id, #! Call the continuation associated with the given id,
#! with 'value' on the top of the stack. #! with 'value' on the top of the stack.
get-registered-continuation call ; get-registered-continuation call ;
#! Name of the variable holding the continuation used to exit #! Name of the variable holding the continuation used to exit
#! back to the httpd responder, returning any generated HTML. #! back to the httpd responder, returning any generated HTML.
SYMBOL: exit-cc SYMBOL: exit-cc
: exit-continuation ( -- exit ) : exit-continuation ( -- exit )
#! Get the current exit continuation #! Get the current exit continuation
exit-cc get ; exit-cc get ;
: call-exit-continuation ( value -- ) : call-exit-continuation ( value -- )
#! Call the exit continuation, passing it the given value on the #! Call the exit continuation, passing it the given value on the
#! top of the stack. #! top of the stack.
exit-cc get continue-with ; exit-cc get continue-with ;
: with-exit-continuation ( quot -- ) : with-exit-continuation ( quot -- )
#! Call the quotation with the variable exit-cc bound such that when #! Call the quotation with the variable exit-cc bound such that when
#! the exit continuation is called, computation will resume from the #! the exit continuation is called, computation will resume from the
#! end of this 'with-exit-continuation' call, with the value passed #! end of this 'with-exit-continuation' call, with the value passed
#! to the exit continuation on the top of the stack. #! to the exit continuation on the top of the stack.
[ exit-cc set call f call-exit-continuation ] callcc1 nip ; [ exit-cc set call f call-exit-continuation ] callcc1 nip ;
#! Name of variable holding the 'callback' continuation, used for #! Name of variable holding the 'callback' continuation, used for
#! returning back to previous 'show' calls. #! returning back to previous 'show' calls.
SYMBOL: callback-cc SYMBOL: callback-cc
: store-callback-cc ( -- ) : store-callback-cc ( -- )
#! Store the current continuation in the variable 'callback-cc' #! Store the current continuation in the variable 'callback-cc'
#! so it can be returned to later by callbacks. Note that it #! so it can be returned to later by callbacks. Note that it
#! recalls itself when the continuation is called to ensure that #! recalls itself when the continuation is called to ensure that
#! it resets its value back to the most recent show call. #! it resets its value back to the most recent show call.
[ ( 0 -- ) [ ( 0 -- )
[ ( 0 1 -- ) [ ( 0 1 -- )
callback-cc set ( 0 -- ) callback-cc set ( 0 -- )
stdio get swap continue-with stdio get swap continue-with
] callcc1 ( 0 [ ] == ) ] callcc1
nip nip
dup resume-stdio stdio set resume-value dup resume-stdio stdio set resume-value
call call
store-callback-cc stdio get store-callback-cc stdio get
] callcc1 stdio set ; ] callcc1 stdio set ;
: forward-to-url ( url -- ) : forward-to-url ( url -- )
#! When executed inside a 'show' call, this will force a #! When executed inside a 'show' call, this will force a
#! HTTP 302 to occur to instruct the browser to forward to #! HTTP 302 to occur to instruct the browser to forward to
#! the request URL. #! the request URL.
[ [
"HTTP/1.1 302 Document Moved\nLocation: " % % "HTTP/1.1 302 Document Moved\nLocation: " % %
"\nContent-Length: 0\nContent-Type: text/plain\n\n" % "\nContent-Length: 0\nContent-Type: text/plain\n\n" %
] "" make write "" call-exit-continuation ; ] "" make write "" call-exit-continuation ;
: forward-to-id ( id -- ) : forward-to-id ( id -- )
#! When executed inside a 'show' call, this will force a #! When executed inside a 'show' call, this will force a
#! HTTP 302 to occur to instruct the browser to forward to #! HTTP 302 to occur to instruct the browser to forward to
#! the request URL. #! the request URL.
>r "request" get r> id>url append forward-to-url ; >r "request" get r> id>url append forward-to-url ;
: redirect-to-here ( -- ) : redirect-to-here ( -- )
#! Force a redirect to the client browser so that the browser #! Force a redirect to the client browser so that the browser
#! goes to the current point in the code. This forces an URL #! goes to the current point in the code. This forces an URL
#! change on the browser so that refreshing that URL will #! change on the browser so that refreshing that URL will
#! immediately run from this code point. This prevents the #! immediately run from this code point. This prevents the
#! "this request will issue a POST" warning from the browser #! "this request will issue a POST" warning from the browser
#! and prevents re-running the previous POST logic. This is #! and prevents re-running the previous POST logic. This is
#! known as the 'post-refresh-get' pattern. #! known as the 'post-refresh-get' pattern.
post-refresh-get? get [ post-refresh-get? get [
[ [
expirable register-continuation forward-to-id expirable register-continuation forward-to-id
] callcc1 resume-stdio stdio set ] callcc1 resume-stdio stdio set
] [ ] [
t post-refresh-get? set t post-refresh-get? set
] if ; ] if ;
: (show) ( quot -- namespace ) : (show) ( quot -- namespace )
#! See comments for show. The difference is the #! See comments for show. The difference is the
#! quotation MUST set the content-type using 'serving-html' #! quotation MUST set the content-type using 'serving-html'
#! or similar. #! or similar.
store-callback-cc redirect-to-here store-callback-cc redirect-to-here
[ [
expirable register-continuation id>url swap expirable register-continuation id>url swap
with-scope "" call-exit-continuation with-scope "" call-exit-continuation
] callcc1 ] callcc1
nip dup resume-stdio stdio set resume-value ; nip dup resume-stdio stdio set resume-value ;
: show ( quot -- namespace ) : show ( quot -- namespace )
#! Call the quotation with the URL associated with the current #! Call the quotation with the URL associated with the current
#! continuation. All output from the quotation goes to the client #! continuation. All output from the quotation goes to the client
#! browser. When the URL is later referenced then #! browser. When the URL is later referenced then
#! computation will resume from this 'show' call with a namespace on #! computation will resume from this 'show' call with a namespace on
#! the stack containing any query or post parameters. #! the stack containing any query or post parameters.
#! NOTE: On return from 'show' the stack is exactly the same as #! NOTE: On return from 'show' the stack is exactly the same as
#! initial entry with 'quot' popped off an <namespace> put on. Even #! initial entry with 'quot' popped off an <namespace> put on. Even
#! if the quotation consumes items on the stack. #! if the quotation consumes items on the stack.
\ serving-html swons (show) ; \ serving-html swons (show) ;
: (show-final) ( quot -- namespace ) : (show-final) ( quot -- namespace )
#! See comments for show-final. The difference is the #! See comments for show-final. The difference is the
#! quotation MUST set the content-type using 'serving-html' #! quotation MUST set the content-type using 'serving-html'
#! or similar. #! or similar.
store-callback-cc redirect-to-here store-callback-cc redirect-to-here
with-scope "" call-exit-continuation ; with-scope "" call-exit-continuation ;
: show-final ( quot -- namespace ) : show-final ( quot -- namespace )
#! Similar to 'show', except the quotation does not receive the URL #! Similar to 'show', except the quotation does not receive the URL
#! to resume computation following 'show-final'. No continuation is #! to resume computation following 'show-final'. No continuation is
#! stored for this resumption. As a result, 'show-final' is for use #! stored for this resumption. As a result, 'show-final' is for use
#! when a page is to be displayed with no further action to occur. Its #! when a page is to be displayed with no further action to occur. Its
#! use is an optimisation to save having to generate and save a continuation #! use is an optimisation to save having to generate and save a continuation
#! in that special case. #! in that special case.
\ serving-html swons (show-final) ; \ serving-html swons (show-final) ;
#! Name of variable for holding initial continuation id that starts #! Name of variable for holding initial continuation id that starts
#! the responder. #! the responder.
SYMBOL: root-continuation SYMBOL: root-continuation
: id-or-root ( -- id ) : id-or-root ( -- id )
#! Return the continuation id for the current requested continuation #! Return the continuation id for the current requested continuation
#! or the root continuation if no id is supplied. #! or the root continuation if no id is supplied.
"id" "query" get hash [ root-continuation get ] unless* ; "id" "query" get hash [ root-continuation get ] unless* ;
: cont-get/post-responder ( id-or-f -- ) : cont-get/post-responder ( id-or-f -- )
#! httpd responder that retrieves a continuation and calls it. #! httpd responder that retrieves a continuation and calls it.
#! The continuation id must be in a query parameter called 'id'. #! The continuation id must be in a query parameter called 'id'.
#! If it does not exist the root continuation is called. If #! If it does not exist the root continuation is called. If
#! no root continuation exists the expired continuation handler #! no root continuation exists the expired continuation handler
#! should be called. #! should be called.
drop [ [
"response" get stdio get <resume> drop [
id-or-root [ "response" get stdio get <resume>
resume-continuation id-or-root [
] [ resume-continuation
(expired-page-handler) "" call-exit-continuation ] [
] if* (expired-page-handler) "" call-exit-continuation
] with-exit-continuation drop ; ] if*
] with-exit-continuation drop
] with-scope ;
: callback-quot ( quot -- quot ) : callback-quot ( quot -- quot )
#! Convert the given quotation so it works as a callback #! Convert the given quotation so it works as a callback
#! by returning a quotation that will pass the original #! by returning a quotation that will pass the original
#! quotation to the callback continuation. #! quotation to the callback continuation.
[ , \ stdio , \ get , \ <resume> , callback-cc get , \ continue-with , ] [ ] make ; [
, \ stdio , \ get , \ <resume> , callback-cc get ,
\ continue-with ,
] [ ] make ;
: quot-url ( quot -- url ) : quot-url ( quot -- url )
callback-quot expirable register-continuation id>url ; callback-quot expirable register-continuation id>url ;
: quot-href ( text quot -- ) : quot-href ( text quot -- )
#! Write to standard output an HTML HREF where the href, #! Write to standard output an HTML HREF where the href,
#! when referenced, will call the quotation and then return #! when referenced, will call the quotation and then return
#! back to the most recent 'show' call (via the callback-cc). #! back to the most recent 'show' call (via the callback-cc).
#! The text of the link will be the 'text' argument on the #! The text of the link will be the 'text' argument on the
#! stack. #! stack.
<a quot-url =href a> write </a> ; <a quot-url =href a> write </a> ;
: init-session-namespace ( <resume> -- ) : init-session-namespace ( <resume> -- )
#! Setup the initial session namespace. Currently this only #! Setup the initial session namespace. Currently this only
#! sets the redirect flag so that the initial request of the #! sets the redirect flag so that the initial request of the
#! responder will not do a post-refresh-get style redirect. #! responder will not do a post-refresh-get style redirect.
#! This prevents the initial request to a responder from redirecting #! This prevents the initial request to a responder from redirecting
#! to an URL with a continuation id. This word must be run from #! to an URL with a continuation id. This word must be run from
#! within the session namespace. #! within the session namespace.
f post-refresh-get? set dup resume-stdio stdio set ; f post-refresh-get? set dup resume-stdio stdio set ;
: install-cont-responder ( name quot -- ) : install-cont-responder ( name quot -- )
#! Install a cont-responder with the given name #! Install a cont-responder with the given name
#! that will initially run the given quotation. #! that will initially run the given quotation.
#! #!
#! Convert the quotation so it is run within a session namespace #! Convert the quotation so it is run within a session namespace
#! and that namespace is initialized first. #! and that namespace is initialized first.
\ init-session-namespace swons [ , \ with-scope , ] [ ] make \ init-session-namespace swons [ , \ with-scope , ] [ ] make
[ [
[ cont-get/post-responder ] "get" set [ cont-get/post-responder ] "get" set
[ cont-get/post-responder ] "post" set [ cont-get/post-responder ] "post" set
swap "responder" set swap "responder" set
permanent register-continuation root-continuation set permanent register-continuation root-continuation set
] make-responder ; ] make-responder ;
: simple-page ( title quot -- ) : simple-page ( title quot -- )
#! Call the quotation, with all output going to the #! Call the quotation, with all output going to the
#! body of an html page with the given title. #! body of an html page with the given title.
<html> <html>
<head> <title> swap write </title> </head> <head> <title> swap write </title> </head>
<body> call </body> <body> call </body>
</html> ; </html> ;
: styled-page ( title stylesheet-quot quot -- ) : styled-page ( title stylesheet-quot quot -- )
#! Call the quotation, with all output going to the #! Call the quotation, with all output going to the
#! body of an html page with the given title. stylesheet-quot #! body of an html page with the given title. stylesheet-quot
#! is called to generate the required stylesheet. #! is called to generate the required stylesheet.
<html> <html>
<head> <head>
<title> rot write </title> <title> rot write </title>
swap call swap call
</head> </head>
<body> call </body> <body> call </body>
</html> ; </html> ;
: paragraph ( str -- ) : paragraph ( str -- )
#! Output the string as an html paragraph #! Output the string as an html paragraph
<p> write </p> ; <p> write </p> ;
: show-message-page ( message -- ) : show-message-page ( message -- )
#! Display the message in an HTML page with an OK button. #! Display the message in an HTML page with an OK button.
[ [
"Press OK to Continue" [ "Press OK to Continue" [
swap paragraph swap paragraph
<a =href a> "OK" write </a> <a =href a> "OK" write </a>
] simple-page ] simple-page
] show 2drop ; ] show 2drop ;
: vertical-layout ( list -- ) : vertical-layout ( list -- )
#! Given a list of HTML components, arrange them vertically. #! Given a list of HTML components, arrange them vertically.
<table> <table>
[ <tr> <td> call </td> </tr> ] each [ <tr> <td> call </td> </tr> ] each
</table> ; </table> ;
: horizontal-layout ( list -- ) : horizontal-layout ( list -- )
#! Given a list of HTML components, arrange them horizontally. #! Given a list of HTML components, arrange them horizontally.
<table> <table>
<tr "top" =valign tr> [ <td> call </td> ] each </tr> <tr "top" =valign tr> [ <td> call </td> ] each </tr>
</table> ; </table> ;
: button ( label -- ) : button ( label -- )
#! Output an HTML submit button with the given label. #! Output an HTML submit button with the given label.
<input "submit" =type =value input/> ; <input "submit" =type =value input/> ;

16
library/unix/io.factor
View File

@ -137,14 +137,16 @@ GENERIC: task-container ( task -- vector )
[ drop t swap rot set-bit-nth ] hash-each-with ; [ drop t swap rot set-bit-nth ] hash-each-with ;
: init-fdsets ( -- read write except ) : init-fdsets ( -- read write except )
read-fdset get [ read-tasks get init-fdset ] keep read-fdset get-global
write-fdset get [ write-tasks get init-fdset ] keep [ read-tasks get-global init-fdset ] keep
write-fdset get-global
[ write-tasks get-global init-fdset ] keep
f ; f ;
: io-multiplex ( timeout -- ) : io-multiplex ( timeout -- )
>r FD_SETSIZE init-fdsets r> make-timeval select io-error >r FD_SETSIZE init-fdsets r> make-timeval select io-error
read-fdset get read-tasks get handle-fdset read-fdset get-global read-tasks get-global handle-fdset
write-fdset get write-tasks get handle-fdset ; write-fdset get-global write-tasks get-global handle-fdset ;
! Readers ! Readers
@ -203,7 +205,7 @@ M: read-task do-io-task ( task -- ? )
2drop f 2drop f
] if ; ] if ;
M: read-task task-container drop read-tasks get ; M: read-task task-container drop read-tasks get-global ;
: wait-to-read ( count port -- ) : wait-to-read ( count port -- )
2dup can-read-count? [ 2dup can-read-count? [
@ -258,10 +260,10 @@ M: write-task do-io-task
write-step f write-step f
] if ; ] if ;
M: write-task task-container drop write-tasks get ; M: write-task task-container drop write-tasks get-global ;
: add-write-io-task ( callback task -- ) : add-write-io-task ( callback task -- )
dup io-task-fd write-tasks get hash [ dup io-task-fd write-tasks get-global hash [
dup write-task? [ dup write-task? [
nip io-task-callbacks enque nip io-task-callbacks enque
] [ ] [