Use inheritance in Unix I?O backend
parent
8460780f61
commit
c5de818925
|
@ -14,18 +14,13 @@ TUPLE: io-task port callbacks ;
|
|||
: io-task-fd port>> handle>> ;
|
||||
|
||||
: <io-task> ( port continuation/f class -- task )
|
||||
>r [ 1vector ] [ V{ } clone ] if* io-task construct-boa
|
||||
r> construct-delegate ; inline
|
||||
construct-empty
|
||||
swap [ 1vector ] [ V{ } clone ] if* >>callbacks
|
||||
swap >>port ; inline
|
||||
|
||||
TUPLE: input-task ;
|
||||
TUPLE: input-task < io-task ;
|
||||
|
||||
: <input-task> ( port continuation class -- task )
|
||||
>r input-task <io-task> r> construct-delegate ; inline
|
||||
|
||||
TUPLE: output-task ;
|
||||
|
||||
: <output-task> ( port continuation class -- task )
|
||||
>r output-task <io-task> r> construct-delegate ; inline
|
||||
TUPLE: output-task < io-task ;
|
||||
|
||||
GENERIC: do-io-task ( task -- ? )
|
||||
GENERIC: io-task-container ( mx task -- hashtable )
|
||||
|
@ -37,9 +32,10 @@ M: input-task io-task-container drop reads>> ;
|
|||
|
||||
M: output-task io-task-container drop writes>> ;
|
||||
|
||||
: <mx> ( -- mx ) f H{ } clone H{ } clone mx construct-boa ;
|
||||
|
||||
: construct-mx ( class -- obj ) <mx> swap construct-delegate ;
|
||||
: construct-mx ( class -- obj )
|
||||
construct-empty
|
||||
H{ } clone >>reads
|
||||
H{ } clone >>writes ; inline
|
||||
|
||||
GENERIC: register-io-task ( task mx -- )
|
||||
GENERIC: unregister-io-task ( task mx -- )
|
||||
|
@ -140,10 +136,10 @@ M: unix cancel-io ( port -- )
|
|||
drop t
|
||||
] if ;
|
||||
|
||||
TUPLE: read-task ;
|
||||
TUPLE: read-task < input-task ;
|
||||
|
||||
: <read-task> ( port continuation -- task )
|
||||
read-task <input-task> ;
|
||||
read-task <io-task> ;
|
||||
|
||||
M: read-task do-io-task
|
||||
io-task-port dup refill
|
||||
|
@ -158,10 +154,10 @@ M: input-port (wait-to-read)
|
|||
dup [ handle>> ] [ buffer@ ] [ buffer-length ] tri write
|
||||
dup 0 >= [ swap buffer-consume f ] [ drop defer-error ] if ;
|
||||
|
||||
TUPLE: write-task ;
|
||||
TUPLE: write-task < output-task ;
|
||||
|
||||
: <write-task> ( port continuation -- task )
|
||||
write-task <output-task> ;
|
||||
write-task <io-task> ;
|
||||
|
||||
M: write-task do-io-task
|
||||
io-task-port dup [ buffer-empty? ] [ port-error ] bi or
|
||||
|
@ -193,7 +189,7 @@ TUPLE: mx-port mx ;
|
|||
dup fd>> f mx-port <port>
|
||||
{ set-mx-port-mx set-delegate } mx-port construct ;
|
||||
|
||||
TUPLE: mx-task ;
|
||||
TUPLE: mx-task < io-task ;
|
||||
|
||||
: <mx-task> ( port -- task )
|
||||
f mx-task <io-task> ;
|
||||
|
|
|
@ -5,7 +5,7 @@ bit-arrays sequences assocs unix unix.linux.epoll math
|
|||
namespaces structs ;
|
||||
IN: io.unix.epoll
|
||||
|
||||
TUPLE: epoll-mx events ;
|
||||
TUPLE: epoll-mx < mx events ;
|
||||
|
||||
: max-events ( -- n )
|
||||
#! We read up to 256 events at a time. This is an arbitrary
|
||||
|
@ -33,12 +33,10 @@ M: output-task io-task-events drop EPOLLOUT ;
|
|||
epoll_ctl io-error ;
|
||||
|
||||
M: epoll-mx register-io-task ( task mx -- )
|
||||
2dup EPOLL_CTL_ADD do-epoll-ctl
|
||||
delegate register-io-task ;
|
||||
[ EPOLL_CTL_ADD do-epoll-ctl ] [ call-next-method ] 2bi ;
|
||||
|
||||
M: epoll-mx unregister-io-task ( task mx -- )
|
||||
2dup delegate unregister-io-task
|
||||
EPOLL_CTL_DEL do-epoll-ctl ;
|
||||
[ call-next-method ] [ EPOLL_CTL_DEL do-epoll-ctl ] 2bi ;
|
||||
|
||||
: wait-event ( mx timeout -- n )
|
||||
>r { mx-fd epoll-mx-events } get-slots max-events
|
||||
|
|
|
@ -8,7 +8,7 @@ io.nonblocking io.unix.backend io.launcher io.unix.launcher
|
|||
io.monitors ;
|
||||
IN: io.unix.kqueue
|
||||
|
||||
TUPLE: kqueue-mx events monitors ;
|
||||
TUPLE: kqueue-mx < mx events monitors ;
|
||||
|
||||
: max-events ( -- n )
|
||||
#! We read up to 256 events at a time. This is an arbitrary
|
||||
|
@ -43,12 +43,14 @@ M: io-task io-task-fflags drop 0 ;
|
|||
0 < [ err_no ESRCH = [ (io-error) ] unless ] when ;
|
||||
|
||||
M: kqueue-mx register-io-task ( task mx -- )
|
||||
over EV_ADD make-kevent over register-kevent
|
||||
delegate register-io-task ;
|
||||
[ >r EV_ADD make-kevent r> register-kevent ]
|
||||
[ call-next-method ]
|
||||
2bi ;
|
||||
|
||||
M: kqueue-mx unregister-io-task ( task mx -- )
|
||||
2dup delegate unregister-io-task
|
||||
swap EV_DELETE make-kevent swap register-kevent ;
|
||||
[ call-next-method ]
|
||||
[ >r EV_DELETE make-kevent r> register-kevent ]
|
||||
2bi ;
|
||||
|
||||
: wait-kevent ( mx timespec -- n )
|
||||
>r [ fd>> f 0 ] keep events>> max-events r> kevent
|
||||
|
|
|
@ -5,7 +5,7 @@ bit-arrays sequences assocs unix math namespaces structs
|
|||
accessors ;
|
||||
IN: io.unix.select
|
||||
|
||||
TUPLE: select-mx read-fdset write-fdset ;
|
||||
TUPLE: select-mx < mx read-fdset write-fdset ;
|
||||
|
||||
! Factor's bit-arrays are an array of bytes, OS X expects
|
||||
! FD_SET to be an array of cells, so we have to account for
|
||||
|
@ -15,8 +15,8 @@ TUPLE: select-mx read-fdset write-fdset ;
|
|||
|
||||
: <select-mx> ( -- mx )
|
||||
select-mx construct-mx
|
||||
FD_SETSIZE 8 * <bit-array> >>read-fdset
|
||||
FD_SETSIZE 8 * <bit-array> >>write-fdset ;
|
||||
FD_SETSIZE 8 * <bit-array> >>read-fdset
|
||||
FD_SETSIZE 8 * <bit-array> >>write-fdset ;
|
||||
|
||||
: clear-nth ( n seq -- ? )
|
||||
[ nth ] [ f -rot set-nth ] 2bi ;
|
||||
|
|
|
@ -30,10 +30,10 @@ M: unix addrinfo-error ( n -- )
|
|||
: init-client-socket ( fd -- )
|
||||
SOL_SOCKET SO_OOBINLINE sockopt ;
|
||||
|
||||
TUPLE: connect-task ;
|
||||
TUPLE: connect-task < output-task ;
|
||||
|
||||
: <connect-task> ( port continuation -- task )
|
||||
connect-task <output-task> ;
|
||||
connect-task <io-task> ;
|
||||
|
||||
M: connect-task do-io-task
|
||||
io-task-port dup port-handle f 0 write
|
||||
|
@ -61,10 +61,10 @@ USE: unix
|
|||
: init-server-socket ( fd -- )
|
||||
SOL_SOCKET SO_REUSEADDR sockopt ;
|
||||
|
||||
TUPLE: accept-task ;
|
||||
TUPLE: accept-task < input-task ;
|
||||
|
||||
: <accept-task> ( port continuation -- task )
|
||||
accept-task <input-task> ;
|
||||
accept-task <io-task> ;
|
||||
|
||||
: accept-sockaddr ( port -- fd sockaddr )
|
||||
dup port-handle swap server-port-addr sockaddr-type
|
||||
|
@ -128,10 +128,10 @@ packet-size <byte-array> receive-buffer set-global
|
|||
rot head
|
||||
] if ;
|
||||
|
||||
TUPLE: receive-task ;
|
||||
TUPLE: receive-task < input-task ;
|
||||
|
||||
: <receive-task> ( stream continuation -- task )
|
||||
receive-task <input-task> ;
|
||||
receive-task <io-task> ;
|
||||
|
||||
M: receive-task do-io-task
|
||||
io-task-port
|
||||
|
@ -157,10 +157,10 @@ M: unix receive ( datagram -- packet addrspec )
|
|||
: do-send ( socket data sockaddr len -- n )
|
||||
>r >r dup length 0 r> r> sendto ;
|
||||
|
||||
TUPLE: send-task packet sockaddr len ;
|
||||
TUPLE: send-task < output-task packet sockaddr len ;
|
||||
|
||||
: <send-task> ( packet sockaddr len stream continuation -- task )
|
||||
send-task <output-task> [
|
||||
send-task <io-task> [
|
||||
{
|
||||
set-send-task-packet
|
||||
set-send-task-sockaddr
|
||||
|
|
Loading…
Reference in New Issue