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

View File

@ -1,29 +1,10 @@
! Copyright (C) 2004 Chris Double.
!
! 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
! See http://factorcode.org/license.txt for BSD license.
USING: http httpd math namespaces io
lists strings kernel html hashtables
parser generic sequences ;
lists strings kernel html hashtables
parser generic sequences ;
IN: cont-responder
#! Used inside the session state of responders to indicate whether the
#! next request should use the post-refresh-get pattern. It is set to
@ -46,13 +27,13 @@ SYMBOL: table
: continuation-table ( -- <hashtable> )
#! Return the global table of continuations
table global hash ;
table get-global ;
: reset-continuation-table ( -- )
#! Create the initial global table
continuation-table clear-hash ;
H{ } clone table global set-hash
H{ } clone table set-global
#! Tuple for holding data related to a continuation.
TUPLE: item expire? quot id time-added ;
@ -79,7 +60,7 @@ TUPLE: item expire? quot id time-added ;
#! Expire all continuations in the continuation table
#! if they are 'timeout-seconds' old (ie. were added
#! more than 'timeout-seconds' ago.
continuation-table clone [ ( timeout-seconds [[ id item ]] -- )
continuation-table clone [
swapd expired? [
continuation-table remove-hash
] [
@ -193,7 +174,7 @@ SYMBOL: callback-cc
[ ( 0 1 -- )
callback-cc set ( 0 -- )
stdio get swap continue-with
] callcc1 ( 0 [ ] == )
] callcc1
nip
dup resume-stdio stdio set resume-value
call
@ -284,6 +265,7 @@ SYMBOL: root-continuation
#! If it does not exist the root continuation is called. If
#! no root continuation exists the expired continuation handler
#! should be called.
[
drop [
"response" get stdio get <resume>
id-or-root [
@ -291,13 +273,17 @@ SYMBOL: root-continuation
] [
(expired-page-handler) "" call-exit-continuation
] if*
] with-exit-continuation drop ;
] with-exit-continuation drop
] with-scope ;
: callback-quot ( quot -- quot )
#! Convert the given quotation so it works as a callback
#! by returning a quotation that will pass the original
#! 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 )
callback-quot expirable register-continuation id>url ;

View File

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