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

Unix I/O code simplification

darcs
slava 2006-06-17 06:29:46 +00:00
parent 11479efbc2
commit 0e2eb30f7d
2 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.FACTOR.txt
View File

@ -1,6 +1,5 @@
+ io: + io:
- pop all callbacks at once
- unix i/o: problems with passing f to syscalls - unix i/o: problems with passing f to syscalls
- factorcode httpd started using 99% CPU, but still received connections; - factorcode httpd started using 99% CPU, but still received connections;
closing read-fds solved it closing read-fds solved it

22
library/unix/io.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: io-internals IN: io-internals
USING: alien arrays errors generic hashtables io kernel USING: alien arrays errors generic hashtables io kernel
kernel-internals math parser queues sequences strings kernel-internals math parser sequences strings threads
threads unix-internals vectors words ; unix-internals vectors words ;
! We want namespaces::bind to shadow the bind system call from ! We want namespaces::bind to shadow the bind system call from
! unix-internals ! unix-internals
@ -93,7 +93,7 @@ M: port set-timeout ( timeout port -- )
TUPLE: io-task port callbacks ; TUPLE: io-task port callbacks ;
C: io-task ( port -- ) C: io-task ( port -- )
[ set-io-task-port ] keep [ set-io-task-port ] keep
<queue> over set-io-task-callbacks ; V{ } clone over set-io-task-callbacks ;
! Multiplexer ! Multiplexer
GENERIC: do-io-task ( task -- ? ) GENERIC: do-io-task ( task -- ? )
@ -102,7 +102,7 @@ GENERIC: task-container ( task -- vector )
: io-task-fd io-task-port port-handle ; : io-task-fd io-task-port port-handle ;
: add-io-task ( callback task -- ) : add-io-task ( callback task -- )
[ >r <queue> [ enque ] keep r> set-io-task-callbacks ] keep [ io-task-callbacks push ] keep
dup io-task-fd over task-container 2dup hash [ dup io-task-fd over task-container 2dup hash [
"Cannot perform multiple reads from the same port" throw "Cannot perform multiple reads from the same port" throw
] when set-hash ; ] when set-hash ;
@ -110,13 +110,13 @@ GENERIC: task-container ( task -- vector )
: remove-io-task ( task -- ) : remove-io-task ( task -- )
dup io-task-fd swap task-container remove-hash ; dup io-task-fd swap task-container remove-hash ;
: pop-callback ( task -- callback ) : pop-callbacks ( task -- )
dup io-task-callbacks dup deque >r dup io-task-callbacks swap remove-io-task
queue-empty? [ remove-io-task ] [ drop ] if r> ; [ schedule-thread ] each ;
: handle-fd ( task -- ) : handle-fd ( task -- )
dup io-task-port touch-port dup do-io-task dup io-task-port touch-port
[ pop-callback schedule-thread ] [ drop ] if ; dup do-io-task [ pop-callbacks ] [ drop ] if ;
: timeout? ( port -- ? ) : timeout? ( port -- ? )
port-cutoff dup zero? not swap millis < and ; port-cutoff dup zero? not swap millis < and ;
@ -125,7 +125,7 @@ GENERIC: task-container ( task -- vector )
[ [
nip dup io-task-port timeout? [ nip dup io-task-port timeout? [
dup io-task-port "Timeout" swap report-error dup io-task-port "Timeout" swap report-error
nip pop-callback schedule-thread nip pop-callbacks
] [ ] [
tuck io-task-fd swap bit-nth tuck io-task-fd swap bit-nth
[ handle-fd ] [ drop ] if [ handle-fd ] [ drop ] if
@ -264,7 +264,7 @@ 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-global hash dup io-task-fd write-tasks get-global hash
[ io-task-callbacks enque ] [ add-io-task ] ?if ; [ io-task-callbacks push ] [ add-io-task ] ?if ;
: port-flush ( port -- ) : port-flush ( port -- )
[ swap <write-task> add-write-io-task stop ] callcc0 drop ; [ swap <write-task> add-write-io-task stop ] callcc0 drop ;