From 5585815935f7599fc956d6d610f685aee8716fda Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Sat, 19 Jan 2008 14:18:30 +0100 Subject: [PATCH 01/15] Add missing structs dependency needed for Unix bootstraping --- extra/io/unix/backend/select/select.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/unix/backend/select/select.factor b/extra/io/unix/backend/select/select.factor index b132c8b9e8..3c808a278f 100644 --- a/extra/io/unix/backend/select/select.factor +++ b/extra/io/unix/backend/select/select.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax kernel io.nonblocking io.unix.backend -bit-arrays sequences assocs unix math namespaces ; +bit-arrays sequences assocs unix math namespaces structs ; IN: io.unix.backend.select TUPLE: unix-select-io ; From 1302a8055d27f3cf14c1d021166811dbe43003ed Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Jan 2008 13:13:04 -0500 Subject: [PATCH 02/15] More kqueue work --- extra/io/unix/backend/kqueue/kqueue.factor | 52 +++++----------------- extra/io/unix/unix.factor | 5 +-- 2 files changed, 13 insertions(+), 44 deletions(-) diff --git a/extra/io/unix/backend/kqueue/kqueue.factor b/extra/io/unix/backend/kqueue/kqueue.factor index 287b88c1c3..226e6c2ec7 100644 --- a/extra/io/unix/backend/kqueue/kqueue.factor +++ b/extra/io/unix/backend/kqueue/kqueue.factor @@ -9,8 +9,6 @@ TUPLE: unix-kqueue-io ; ! Global variables SYMBOL: kqueue-fd -SYMBOL: kqueue-added -SYMBOL: kqueue-deleted SYMBOL: kqueue-events : max-events ( -- n ) @@ -19,29 +17,9 @@ SYMBOL: kqueue-events 256 ; inline M: unix-kqueue-io init-unix-io ( -- ) - H{ } clone kqueue-added set-global - H{ } clone kqueue-deleted set-global max-events "kevent" kqueue-events set-global kqueue dup io-error kqueue-fd set-global ; -M: unix-kqueue-io register-io-task ( task -- ) - dup io-task-fd kqueue-added get-global key? [ drop ] [ - dup io-task-fd kqueue-deleted get-global key? [ - io-task-fd kqueue-deleted get-global delete-at - ] [ - dup io-task-fd kqueue-added get-global set-at - ] if - ] if ; - -M: unix-kqueue-io unregister-io-task ( task -- ) - dup io-task-fd kqueue-deleted get-global key? [ drop ] [ - dup io-task-fd kqueue-added get-global key? [ - io-task-fd kqueue-added get-global delete-at - ] [ - dup io-task-fd kqueue-deleted get-global set-at - ] if - ] if ; - : io-task-filter ( task -- n ) class { { read-task [ EVFILT_READ ] } @@ -57,6 +35,10 @@ M: unix-kqueue-io unregister-io-task ( task -- ) over io-task-fd over set-kevent-ident swap io-task-filter over set-kevent-filter ; +: register-kevent ( task flags -- ) + >r make-kevent r> over set-kevent-flags + kqueue-fd get-global swap 1 f 0 f kevent io-error ; + : make-add-kevent ( task -- event ) make-kevent EV_ADD over set-kevent-flags ; @@ -65,28 +47,16 @@ M: unix-kqueue-io unregister-io-task ( task -- ) make-kevent EV_DELETE over set-kevent-flags ; -: kqueue-additions ( -- kevents ) - kqueue-added get-global - dup clear-assoc values - [ make-add-kevent ] map ; +M: unix-kqueue-io register-io-task ( task -- ) + EV_ADD EV_ENABLE bitor register-kevent ; -: kqueue-deletions ( -- kevents ) - kqueue-deleted get-global - dup clear-assoc values - [ make-delete-kevent ] map ; +M: unix-kqueue-io unregister-io-task ( task -- ) + EV_DELETE EV_DISABLE bitor register-kevent ; -: kqueue-changelist ( -- byte-array n ) - kqueue-additions kqueue-deletions append - dup concat f like swap length ; - -: kqueue-eventlist ( -- byte-array n ) - kqueue-events get-global max-events ; - -: do-kevent ( timespec -- n ) +: wait-kevent ( timespec -- n ) >r kqueue-fd get-global - kqueue-changelist - kqueue-eventlist + f 0 kqueue-events get-global max-events r> kevent dup multiplexer-error ; : kevent-task ( kevent -- task ) @@ -100,7 +70,7 @@ M: unix-kqueue-io unregister-io-task ( task -- ) M: unix-kqueue-io unix-io-multiplex ( ms -- ) make-timespec - do-kevent + wait-kevent kqueue-events get-global handle-kevents ; T{ unix-kqueue-io } unix-io-backend set-global diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor index 3800008864..1c86224433 100755 --- a/extra/io/unix/unix.factor +++ b/extra/io/unix/unix.factor @@ -3,9 +3,8 @@ io.unix.launcher io.unix.mmap io.backend combinators namespaces system vocabs.loader ; { - ! kqueue is a work in progress - ! { [ macosx? ] [ "io.unix.backend.kqueue" ] } - ! { [ bsd? ] [ "io.unix.backend.kqueue" ] } + { [ macosx? ] [ "io.unix.backend.kqueue" ] } + { [ bsd? ] [ "io.unix.backend.kqueue" ] } { [ unix? ] [ "io.unix.backend.select" ] } } cond require From 7db1b072f8972d7e88c4174401bfb9256488958f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Jan 2008 17:06:38 -0500 Subject: [PATCH 03/15] epoll() binding --- extra/unix/linux/epoll/epoll.factor | 30 +++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 extra/unix/linux/epoll/epoll.factor diff --git a/extra/unix/linux/epoll/epoll.factor b/extra/unix/linux/epoll/epoll.factor new file mode 100644 index 0000000000..946c387acc --- /dev/null +++ b/extra/unix/linux/epoll/epoll.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: unix.linux.epoll +USING: alien.syntax ; + +FUNCTION: int epoll_create ( int size ) ; + +FUNCTION: int epoll_ctl ( int epfd, int op, int fd, epoll_event* event ) ; + +C-STRUCT: epoll-event + { "uint" "events" } + { "uint" "fd" } ; + +FUNCTION: int epoll_wait ( int epfd, epoll_event* events, int maxevents, int timeout ) ; + +: EPOLL_CTL_ADD 1 ; inline ! Add a file decriptor to the interface. +: EPOLL_CTL_DEL 2 ; inline ! Remove a file decriptor from the interface. +: EPOLL_CTL_MOD 3 ; inline ! Change file decriptor epoll_event structure. + +: EPOLLIN HEX: 001 ; inline +: EPOLLPRI HEX: 002 ; inline +: EPOLLOUT HEX: 004 ; inline +: EPOLLRDNORM HEX: 040 ; inline +: EPOLLRDBAND HEX: 080 ; inline +: EPOLLWRNORM HEX: 100 ; inline +: EPOLLWRBAND HEX: 200 ; inline +: EPOLLMSG HEX: 400 ; inline +: EPOLLERR HEX: 008 ; inline +: EPOLLHUP HEX: 010 ; inline +: EPOLLET 31 2^ ; inline From eb5644ad5f05093fe69c2586ec36232d7b6329f6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Jan 2008 17:07:18 -0500 Subject: [PATCH 04/15] Unix I/O re-working; nested multiplexer support, use kqueue on *bsd to wait for process completion, start Linux epoll support --- extra/io/unix/backend/backend.factor | 118 +++++++++++---------- extra/io/unix/backend/kqueue/kqueue.factor | 76 ------------- extra/io/unix/backend/select/select.factor | 52 --------- extra/io/unix/bsd/bsd.factor | 29 +++++ extra/io/unix/epoll/epoll.factor | 61 +++++++++++ extra/io/unix/kqueue/kqueue.factor | 90 ++++++++++++++++ extra/io/unix/launcher/launcher.factor | 37 ++++--- extra/io/unix/linux/linux.factor | 17 +++ extra/io/unix/select/select.factor | 47 ++++++++ extra/io/unix/sockets/sockets.factor | 8 +- extra/io/unix/unix.factor | 9 +- extra/unix/process/process.factor | 62 +++++------ 12 files changed, 367 insertions(+), 239 deletions(-) delete mode 100644 extra/io/unix/backend/kqueue/kqueue.factor delete mode 100644 extra/io/unix/backend/select/select.factor create mode 100644 extra/io/unix/bsd/bsd.factor create mode 100644 extra/io/unix/epoll/epoll.factor create mode 100644 extra/io/unix/kqueue/kqueue.factor create mode 100644 extra/io/unix/linux/linux.factor create mode 100644 extra/io/unix/select/select.factor diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index f29d71dd86..19856dc6be 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -7,19 +7,46 @@ continuations system libc qualified namespaces ; QUALIFIED: io IN: io.unix.backend -! Multiplexer protocol -SYMBOL: unix-io-backend +MIXIN: unix-io -HOOK: init-unix-io unix-io-backend ( -- ) -HOOK: register-io-task unix-io-backend ( task -- ) -HOOK: unregister-io-task unix-io-backend ( task -- ) -HOOK: unix-io-multiplex unix-io-backend ( timeval -- ) +! I/O tasks +TUPLE: io-task port callbacks ; -TUPLE: unix-io ; +: io-task-fd io-task-port port-handle ; -! Global variables -SYMBOL: read-tasks -SYMBOL: write-tasks +: ( port continuation class -- task ) + >r 1vector io-task construct-boa r> construct-delegate ; + inline + +GENERIC: do-io-task ( task -- ? ) +GENERIC: io-task-container ( mx task -- hashtable ) + +! I/O multiplexers +TUPLE: mx fd reads writes ; + +: ( -- mx ) f H{ } clone H{ } clone mx construct-boa ; + +: construct-mx ( class -- obj ) swap construct-delegate ; + +GENERIC: register-io-task ( task mx -- ) +GENERIC: unregister-io-task ( task mx -- ) +GENERIC: unix-io-multiplex ( ms mx -- ) + +: fd/container ( task mx -- task fd container ) + over io-task-container >r dup io-task-fd r> ; inline + +: check-io-task ( task mx -- ) + fd/container key? nip [ + "Cannot perform multiple reads from the same port" throw + ] when ; + +M: mx register-io-task ( task mx -- ) + 2dup check-io-task fd/container set-at ; + +: add-io-task ( task -- ) mx get-global register-io-task ; + +M: mx unregister-io-task ( task mx -- ) + fd/container delete-at drop ; ! Some general stuff : file-mode OCT: 0666 ; @@ -52,43 +79,15 @@ M: integer close-handle ( fd -- ) err_no dup ignorable-error? [ 2drop f ] [ strerror swap report-error t ] if ; -! Associates a port with a list of continuations waiting on the -! port to finish I/O -TUPLE: io-task port callbacks ; - -: ( port continuation class -- task ) - >r 1vector io-task construct-boa r> construct-delegate ; - inline - -! Multiplexer -GENERIC: do-io-task ( task -- ? ) -GENERIC: task-container ( task -- vector ) - -: io-task-fd io-task-port port-handle ; - -: check-io-task ( task -- ) - dup io-task-fd swap task-container at [ - "Cannot perform multiple reads from the same port" throw - ] when ; - -: add-io-task ( task -- ) - dup check-io-task - dup register-io-task - dup io-task-fd over task-container set-at ; - -: remove-io-task ( task -- ) - dup io-task-fd over task-container delete-at - unregister-io-task ; - -: pop-callbacks ( task -- ) - dup remove-io-task +: pop-callbacks ( mx task -- ) + dup rot unregister-io-task io-task-callbacks [ schedule-thread ] each ; -: handle-fd ( task -- ) +: handle-io-task ( mx task -- ) dup io-task-port touch-port - dup do-io-task [ pop-callbacks ] [ drop ] if ; + dup do-io-task [ pop-callbacks ] [ 2drop ] if ; -: handle-timeout ( task -- ) +: handle-timeout ( mx task -- ) "Timeout" over io-task-port report-error pop-callbacks ; ! Readers @@ -119,8 +118,7 @@ M: read-task do-io-task io-task-port dup refill [ [ reader-eof ] [ drop ] if ] keep ; -M: read-task task-container - drop read-tasks get-global ; +M: read-task io-task-container drop mx-reads ; M: input-port (wait-to-read) [ add-io-task stop ] callcc0 pending-error ; @@ -139,13 +137,12 @@ M: write-task do-io-task io-task-port dup buffer-empty? over port-error or [ 0 swap buffer-reset t ] [ write-step ] if ; -M: write-task task-container - drop write-tasks get-global ; +M: write-task io-task-container drop mx-writes ; : add-write-io-task ( port continuation -- ) - over port-handle write-tasks get-global at + over port-handle mx get-global mx-writes at* [ io-task-callbacks push drop ] - [ add-io-task ] if* ; + [ drop add-io-task ] if ; : (wait-to-write) ( port -- ) [ add-write-io-task stop ] callcc0 drop ; @@ -154,16 +151,27 @@ M: port port-flush ( port -- ) dup buffer-empty? [ drop ] [ (wait-to-write) ] if ; M: unix-io io-multiplex ( ms -- ) - unix-io-multiplex ; - -M: unix-io init-io ( -- ) - H{ } clone read-tasks set-global - H{ } clone write-tasks set-global - init-unix-io ; + mx get-global unix-io-multiplex ; M: unix-io init-stdio ( -- ) 0 1 handle>duplex-stream io:stdio set-global 2 io:stderr set-global ; +! mx io-task for embedding an fd-based mx inside another mx +TUPLE: mx-port mx ; + +: ( mx -- port ) + dup mx-fd f + mx-port over set-port-type + { set-mx-port-mx set-delegate } mx-port construct ; + +TUPLE: mx-task ; + +: ( port -- task ) + f io-task construct-boa mx-task construct-delegate ; + +M: mx-task do-io-task + io-task-port mx-port-mx 0 swap unix-io-multiplex f ; + : multiplexer-error ( n -- ) 0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ; diff --git a/extra/io/unix/backend/kqueue/kqueue.factor b/extra/io/unix/backend/kqueue/kqueue.factor deleted file mode 100644 index 226e6c2ec7..0000000000 --- a/extra/io/unix/backend/kqueue/kqueue.factor +++ /dev/null @@ -1,76 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel io.nonblocking io.unix.backend -io.unix.sockets sequences assocs unix unix.kqueue math -namespaces classes combinators ; -IN: io.unix.backend.kqueue - -TUPLE: unix-kqueue-io ; - -! Global variables -SYMBOL: kqueue-fd -SYMBOL: kqueue-events - -: max-events ( -- n ) - #! We read up to 256 events at a time. This is an arbitrary - #! constant... - 256 ; inline - -M: unix-kqueue-io init-unix-io ( -- ) - max-events "kevent" kqueue-events set-global - kqueue dup io-error kqueue-fd set-global ; - -: io-task-filter ( task -- n ) - class { - { read-task [ EVFILT_READ ] } - { accept-task [ EVFILT_READ ] } - { receive-task [ EVFILT_READ ] } - { write-task [ EVFILT_WRITE ] } - { connect-task [ EVFILT_WRITE ] } - { send-task [ EVFILT_WRITE ] } - } case ; - -: make-kevent ( task -- event ) - "kevent" - over io-task-fd over set-kevent-ident - swap io-task-filter over set-kevent-filter ; - -: register-kevent ( task flags -- ) - >r make-kevent r> over set-kevent-flags - kqueue-fd get-global swap 1 f 0 f kevent io-error ; - -: make-add-kevent ( task -- event ) - make-kevent - EV_ADD over set-kevent-flags ; - -: make-delete-kevent ( task -- event ) - make-kevent - EV_DELETE over set-kevent-flags ; - -M: unix-kqueue-io register-io-task ( task -- ) - EV_ADD EV_ENABLE bitor register-kevent ; - -M: unix-kqueue-io unregister-io-task ( task -- ) - EV_DELETE EV_DISABLE bitor register-kevent ; - -: wait-kevent ( timespec -- n ) - >r - kqueue-fd get-global - f 0 kqueue-events get-global max-events - r> kevent dup multiplexer-error ; - -: kevent-task ( kevent -- task ) - dup kevent-ident swap kevent-filter { - { [ dup EVFILT_READ = ] [ read-tasks ] } - { [ dup EVFILT_WRITE = ] [ write-tasks ] } - } cond nip get at ; - -: handle-kevents ( n eventlist -- ) - [ kevent-nth kevent-task handle-fd ] curry each ; - -M: unix-kqueue-io unix-io-multiplex ( ms -- ) - make-timespec - wait-kevent - kqueue-events get-global handle-kevents ; - -T{ unix-kqueue-io } unix-io-backend set-global diff --git a/extra/io/unix/backend/select/select.factor b/extra/io/unix/backend/select/select.factor deleted file mode 100644 index 3c808a278f..0000000000 --- a/extra/io/unix/backend/select/select.factor +++ /dev/null @@ -1,52 +0,0 @@ -! Copyright (C) 2004, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax kernel io.nonblocking io.unix.backend -bit-arrays sequences assocs unix math namespaces structs ; -IN: io.unix.backend.select - -TUPLE: unix-select-io ; - -! Global variables -SYMBOL: read-fdset -SYMBOL: write-fdset - -M: unix-select-io init-unix-io ( -- ) - FD_SETSIZE 8 * read-fdset set-global - FD_SETSIZE 8 * write-fdset set-global ; - -: handle-fdset ( fdset tasks -- ) - swap [ - swap dup io-task-port timeout? [ - nip handle-timeout - ] [ - tuck io-task-fd swap nth - [ handle-fd ] [ drop ] if - ] if drop - ] curry assoc-each ; - -: init-fdset ( fdset tasks -- ) - swap dup clear-bits - [ >r drop t swap r> set-nth ] curry assoc-each ; - -: read-fdset/tasks - read-fdset get-global read-tasks get-global ; - -: write-fdset/tasks - write-fdset get-global write-tasks get-global ; - -: init-fdsets ( -- read write except ) - read-fdset/tasks dupd init-fdset - write-fdset/tasks dupd init-fdset - f ; - -M: unix-select-io register-io-task ( task -- ) drop ; - -M: unix-select-io unregister-io-task ( task -- ) drop ; - -M: unix-select-io unix-io-multiplex ( timeval -- ) - make-timeval >r FD_SETSIZE init-fdsets r> - select multiplexer-error - read-fdset/tasks handle-fdset - write-fdset/tasks handle-fdset ; - -T{ unix-select-io } unix-io-backend set-global diff --git a/extra/io/unix/bsd/bsd.factor b/extra/io/unix/bsd/bsd.factor new file mode 100644 index 0000000000..8ed84dc305 --- /dev/null +++ b/extra/io/unix/bsd/bsd.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: io.unix.bsd +USING: io.backend io.unix.backend io.unix.kqueue io.unix.select +io.unix.launcher namespaces kernel assocs threads continuations +; + +! On *BSD and Mac OS X, we use select() for the top-level +! multiplexer, and we hang a kqueue off of it but file change +! notification and process exit notification. + +! kqueue is buggy with files and ptys so we can't use it as the +! main multiplexer. + +TUPLE: bsd-io ; + +INSTANCE: bsd-io unix-io + +M: bsd-io init-io ( -- ) + mx set-global + kqueue-mx set-global + kqueue-mx get-global dup io-task-fd + 2dup mx get-global mx-reads set-at + mx get-global mx-writes set-at ; + +M: bsd-io wait-for-process ( pid -- status ) + [ kqueue-mx get-global add-pid-task stop ] curry callcc1 ; + +T{ bsd-io } io-backend set-global diff --git a/extra/io/unix/epoll/epoll.factor b/extra/io/unix/epoll/epoll.factor new file mode 100644 index 0000000000..e39c35aca3 --- /dev/null +++ b/extra/io/unix/epoll/epoll.factor @@ -0,0 +1,61 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types kernel io.nonblocking io.unix.backend +bit-arrays sequences assocs unix math namespaces structs ; +IN: io.unix.epoll + +TUPLE: epoll-mx events ; + +: max-events ( -- n ) + #! We read up to 256 events at a time. This is an arbitrary + #! constant... + 256 ; inline + +: ( -- mx ) + epoll-mx construct-mx + max-events epoll_create dup io-error over set-mx-fd + max-events "epoll-event" over set-epoll-mx-events ; + +: io-task-filter ( task -- n ) + class { + { read-task [ EVFILT_READ ] } + { accept-task [ EVFILT_READ ] } + { receive-task [ EVFILT_READ ] } + { write-task [ EVFILT_WRITE ] } + { connect-task [ EVFILT_WRITE ] } + { send-task [ EVFILT_WRITE ] } + } case ; + +: make-event ( task -- event ) + "epoll-event" + tuck set-epoll-event-events + over io-task-fd over set-epoll-fd ; + +: do-epoll-ctl ( task mx what -- ) + >r >r make-event r> mx-fd r> pick event-data *int roll + epoll_ctl io-error ; + +M: epoll-mx register-io-task ( task mx -- ) + EPOLL_CTL_ADD do-epoll-ctl ; + +M: epoll-mx unregister-io-task ( task mx -- ) + EPOLL_CTL_DEL do-epoll-ctl ; + +: wait-kevent ( mx timeout -- n ) + >r mx-fd epoll-mx-events max-events r> epoll_wait + dup multiplexer-error ; + +: epoll-read-task ( mx fd -- ) + over mx-reads at* [ handle-io-task ] [ 2drop ] if ; + +: epoll-write-task ( mx fd -- ) + over mx-reads at* [ handle-io-task ] [ 2drop ] if ; + +: handle-event ( mx kevent -- ) + epoll-event-fd 2dup epoll-read-task epoll-write-task ; + +: handle-events ( mx n -- ) + [ over epoll-mx-events kevent-nth handle-kevent ] with each ; + +M: epoll-mx unix-io-multiplex ( ms mx -- ) + dup rot wait-kevent handle-kevents ; diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor new file mode 100644 index 0000000000..e1ce7666f1 --- /dev/null +++ b/extra/io/unix/kqueue/kqueue.factor @@ -0,0 +1,90 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types kernel io.nonblocking io.unix.backend +io.unix.sockets sequences assocs unix unix.kqueue unix.process +math namespaces classes combinators threads vectors ; +IN: io.unix.kqueue + +TUPLE: kqueue-mx events processes ; + +: max-events ( -- n ) + #! We read up to 256 events at a time. This is an arbitrary + #! constant... + 256 ; inline + +: ( -- mx ) + kqueue-mx construct-mx + kqueue dup io-error over set-mx-fd + H{ } clone over set-kqueue-mx-processes + max-events "kevent" over set-kqueue-mx-events ; + +: io-task-filter ( task -- n ) + class { + { read-task [ EVFILT_READ ] } + { accept-task [ EVFILT_READ ] } + { receive-task [ EVFILT_READ ] } + { write-task [ EVFILT_WRITE ] } + { connect-task [ EVFILT_WRITE ] } + { send-task [ EVFILT_WRITE ] } + } case ; + +: make-kevent ( task flags -- event ) + "kevent" + tuck set-kevent-flags + over io-task-fd over set-kevent-ident + swap io-task-filter over set-kevent-filter ; + +: register-kevent ( kevent mx -- ) + mx-fd swap 1 f 0 f kevent io-error ; + +M: kqueue-mx register-io-task ( task mx -- ) + over EV_ADD make-kevent over register-kevent + delegate register-io-task ; + +M: kqueue-mx unregister-io-task ( task mx -- ) + 2dup delegate unregister-io-task + swap EV_DELETE make-kevent swap register-kevent ; + +: wait-kevent ( mx timespec -- n ) + >r dup mx-fd f 0 roll kqueue-mx-events max-events r> kevent + dup multiplexer-error ; + +: kevent-read-task ( mx fd -- ) + over mx-reads at handle-io-task ; + +: kevent-write-task ( mx fd -- ) + over mx-reads at handle-io-task ; + +: kevent-proc-task ( mx pid -- ) + dup (wait-for-pid) spin kqueue-mx-processes delete-at* [ + [ schedule-thread-with ] with each + ] [ 2drop ] if ; + +: handle-kevent ( mx kevent -- ) + dup kevent-ident swap kevent-filter { + { [ dup EVFILT_READ = ] [ drop kevent-read-task ] } + { [ dup EVFILT_WRITE = ] [ drop kevent-write-task ] } + { [ dup EVFILT_PROC = ] [ drop kevent-proc-task ] } + } cond ; + +: handle-kevents ( mx n -- ) + [ over kqueue-mx-events kevent-nth handle-kevent ] with each ; + +M: kqueue-mx unix-io-multiplex ( ms mx -- ) + swap make-timespec dupd wait-kevent handle-kevents ; + +: make-proc-kevent ( pid -- kevent ) + "kevent" + tuck set-kevent-ident + EV_ADD over set-kevent-flags + EVFILT_PROC over set-kevent-filter + NOTE_EXIT over set-kevent-fflags ; + +: add-pid-task ( continuation pid mx -- ) + 2dup kqueue-mx-processes at* [ + 2nip push + ] [ + drop + over make-proc-kevent over register-kevent + >r >r 1vector r> r> kqueue-mx-processes set-at + ] if ; diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 74bced16c4..adf571a8b7 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -1,14 +1,18 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.launcher io.unix.backend io.nonblocking -sequences kernel namespaces math system alien.c-types -debugger continuations arrays assocs combinators unix.process +USING: io io.backend io.launcher io.unix.backend io.nonblocking +sequences kernel namespaces math system alien.c-types debugger +continuations arrays assocs combinators unix.process parser-combinators memoize promises strings ; IN: io.unix.launcher ! Search unix first USE: unix +HOOK: wait-for-process io-backend ( pid -- status ) + +M: unix-io wait-for-process ( pid -- status ) wait-for-pid ; + ! Our command line parser. Supported syntax: ! foo bar baz -- simple tokens ! foo\ bar -- escaping the space @@ -44,28 +48,26 @@ MEMO: 'arguments' ( -- parser ) : (spawn-process) ( -- ) [ - pass-environment? [ - get-arguments get-environment assoc>env exec-args-with-env - ] [ - get-arguments exec-args-with-path - ] if io-error + get-arguments + pass-environment? + [ get-environment assoc>env exec-args-with-env ] + [ exec-args-with-path ] if + io-error ] [ error. :c flush ] recover 1 exit ; -: wait-for-process ( pid -- ) - 0 0 waitpid drop ; - : spawn-process ( -- pid ) [ (spawn-process) ] [ ] with-fork ; : spawn-detached ( -- ) - [ spawn-process 0 exit ] [ ] with-fork wait-for-process ; + [ spawn-process 0 exit ] [ ] with-fork + wait-for-process drop ; M: unix-io run-process* ( desc -- ) [ +detached+ get [ spawn-detached ] [ - spawn-process wait-for-process + spawn-process wait-for-process drop ] if ] with-descriptor ; @@ -85,15 +87,16 @@ M: unix-io run-process* ( desc -- ) -rot 2dup second close first close ] with-fork first swap second rot ; -TUPLE: pipe-stream pid ; +TUPLE: pipe-stream pid status ; : ( in out pid -- stream ) - pipe-stream construct-boa + f pipe-stream construct-boa -rot handle>duplex-stream over set-delegate ; M: pipe-stream stream-close dup delegate stream-close - pipe-stream-pid wait-for-process ; + dup pipe-stream-pid wait-for-process + swap set-pipe-stream-status ; M: unix-io process-stream* [ spawn-process-stream ] with-descriptor ; diff --git a/extra/io/unix/linux/linux.factor b/extra/io/unix/linux/linux.factor new file mode 100644 index 0000000000..180e81e30a --- /dev/null +++ b/extra/io/unix/linux/linux.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: io.unix.linux +USING: io.unix.backend io.unix.select namespaces kernel assocs ; + +TUPLE: linux-io ; + +INSTANCE: linux-io unix-io + +M: linux-io init-io ( -- ) + start-wait-loop + mx set-global ; + +M: linux-io wait-for-pid ( pid -- status ) + [ kqueue-mx get-global add-pid-task stop ] curry callcc1 ; + +T{ linux-io } io-backend set-global diff --git a/extra/io/unix/select/select.factor b/extra/io/unix/select/select.factor new file mode 100644 index 0000000000..e74324f3b6 --- /dev/null +++ b/extra/io/unix/select/select.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2004, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types kernel io.nonblocking io.unix.backend +bit-arrays sequences assocs unix math namespaces structs ; +IN: io.unix.select + +TUPLE: select-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 +! byte order differences on big endian platforms +: little-endian? 1 *char 1 = ; foldable + +: munge ( i -- i' ) + little-endian? [ BIN: 11000 bitxor ] unless ; inline + +: ( -- mx ) + select-mx construct-mx + FD_SETSIZE 8 * over set-select-mx-read-fdset + FD_SETSIZE 8 * over set-select-mx-write-fdset ; + +: handle-fd ( fd task fdset mx -- ) + roll munge rot nth [ swap handle-io-task ] [ 2drop ] if ; + +: handle-fdset ( tasks fdset mx -- ) + [ handle-fd ] 2curry assoc-each ; + +: init-fdset ( tasks fdset -- ) + dup clear-bits + [ >r drop t swap munge r> set-nth ] curry assoc-each ; + +: read-fdset/tasks + { mx-reads select-mx-read-fdset } get-slots ; + +: write-fdset/tasks + { mx-writes select-mx-write-fdset } get-slots ; + +: init-fdsets ( mx -- read write except ) + [ read-fdset/tasks tuck init-fdset ] keep + write-fdset/tasks tuck init-fdset + f ; + +M: select-mx unix-io-multiplex ( ms mx -- ) + swap >r FD_SETSIZE over init-fdsets r> make-timeval + select multiplexer-error + dup read-fdset/tasks pick handle-fdset + dup write-fdset/tasks rot handle-fdset ; diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 30d3bbd94c..81c0e50b42 100644 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -40,7 +40,7 @@ M: connect-task do-io-task io-task-port dup port-handle f 0 write 0 < [ defer-error ] [ drop t ] if ; -M: connect-task task-container drop write-tasks get-global ; +M: connect-task io-task-container drop mx-writes ; : wait-to-connect ( port -- ) [ add-io-task stop ] callcc0 drop ; @@ -70,7 +70,7 @@ TUPLE: accept-task ; : ( port continuation -- task ) accept-task ; -M: accept-task task-container drop read-tasks get ; +M: accept-task io-task-container drop mx-reads ; : accept-sockaddr ( port -- fd sockaddr ) dup port-handle swap server-port-addr sockaddr-type @@ -152,7 +152,7 @@ M: receive-task do-io-task 2drop defer-error ] if ; -M: receive-task task-container drop read-tasks get ; +M: receive-task io-task-container drop mx-reads ; : wait-receive ( stream -- ) [ add-io-task stop ] callcc0 drop ; @@ -185,7 +185,7 @@ M: send-task do-io-task [ send-task-len do-send ] keep swap 0 < [ io-task-port defer-error ] [ drop t ] if ; -M: send-task task-container drop write-tasks get ; +M: send-task io-task-container drop mx-writes ; : wait-send ( packet sockaddr len stream -- ) [ add-io-task stop ] callcc0 2drop 2drop ; diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor index 1c86224433..d6d0a9cc22 100755 --- a/extra/io/unix/unix.factor +++ b/extra/io/unix/unix.factor @@ -3,9 +3,8 @@ io.unix.launcher io.unix.mmap io.backend combinators namespaces system vocabs.loader ; { - { [ macosx? ] [ "io.unix.backend.kqueue" ] } - { [ bsd? ] [ "io.unix.backend.kqueue" ] } - { [ unix? ] [ "io.unix.backend.select" ] } + { [ bsd? ] [ "io.unix.bsd" ] } + { [ macosx? ] [ "io.unix.bsd" ] } + { [ linux? ] [ "io.unix.backend.linux" ] } + { [ solaris? ] [ "io.unix.backend.solaris" ] } } cond require - -T{ unix-io } io-backend set-global diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index a99611aba6..b2877dc4a1 100644 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -1,53 +1,55 @@ - -USING: kernel alien.c-types sequences math unix combinators.cleave ; +USING: kernel alien.c-types sequences math unix +combinators.cleave vectors kernel namespaces continuations +threads assocs vectors ; IN: unix.process -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Low-level Unix process launching utilities. These are used +! to implement io.launcher on Unix. User code should use +! io.launcher instead. : >argv ( seq -- alien ) [ malloc-char-string ] map f add >c-void*-array ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : exec ( pathname argv -- int ) - [ malloc-char-string ] [ >argv ] bi* execv ; + [ malloc-char-string ] [ >argv ] bi* execv ; : exec-with-path ( filename argv -- int ) - [ malloc-char-string ] [ >argv ] bi* execvp ; + [ malloc-char-string ] [ >argv ] bi* execvp ; : exec-with-env ( filename argv envp -- int ) - [ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ; + [ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: exec-args ( seq -- int ) + [ first ] [ ] bi exec ; -: exec-args ( seq -- int ) [ first ] [ ] bi exec ; -: exec-args-with-path ( seq -- int ) [ first ] [ ] bi exec-with-path ; +: exec-args-with-path ( seq -- int ) + [ first ] [ ] bi exec-with-path ; -: exec-args-with-env ( seq seq -- int ) >r [ first ] [ ] bi r> exec-with-env ; +: exec-args-with-env ( seq seq -- int ) + >r [ first ] [ ] bi r> exec-with-env ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: with-fork ( child parent -- ) + fork dup zero? -roll swap curry if ; inline -: with-fork ( child parent -- ) fork dup zero? -roll swap curry if ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USING: kernel alien.c-types namespaces continuations threads assocs unix - combinators.cleave ; +! Lame polling strategy for getting process exit codes. On +! BSD, we use kqueue which is more efficient. SYMBOL: pid-wait -! KEY | VALUE -! ----------- -! pid | continuation +: (wait-for-pid) ( pid -- status ) + 0 [ 0 waitpid drop ] keep *int ; -: init-pid-wait ( -- ) H{ } clone pid-wait set-global ; - -: wait-for-pid ( pid -- status ) [ pid-wait get set-at stop ] curry callcc1 ; +: wait-for-pid ( pid -- status ) + [ pid-wait get-global [ ?push ] change-at stop ] curry + callcc1 ; : wait-loop ( -- ) - -1 0 tuck WNOHANG waitpid ! &status return - [ *int ] [ pid-wait get delete-at* drop ] bi* ! status ? - dup [ schedule-thread-with ] [ 2drop ] if - 250 sleep wait-loop ; + -1 0 tuck WNOHANG waitpid ! &status return + [ *int ] [ pid-wait get delete-at* drop ] bi* ! status ? + [ schedule-thread-with ] with each + 250 sleep + wait-loop ; -: start-wait-loop ( -- ) init-pid-wait [ wait-loop ] in-thread ; \ No newline at end of file +: start-wait-loop ( -- ) + H{ } clone pid-wait set-global + [ wait-loop ] in-thread ; \ No newline at end of file From feb4e8df9e0d5159cbe68dd85754d769ec0605b4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 21 Jan 2008 15:33:37 -0500 Subject: [PATCH 05/15] Fix typo --- core/math/math-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 307a5531a1..1ec3592c79 100755 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -209,7 +209,7 @@ HELP: bitxor HELP: shift { $values { "x" integer } { "n" integer } { "y" integer } } -{ $description "Shifts " { $snippet "x" } " to the left by " { $snippet "y" } " bits if " { $snippet "y" } " is positive, or " { $snippet "-y" } " bits to the right if " { $snippet "y" } " is negative. A left shift of a fixnum may overflow, yielding a bignum. A right shift may result in bits ``falling off'' the right hand side and being discarded." } +{ $description "Shifts " { $snippet "x" } " to the left by " { $snippet "n" } " bits if " { $snippet "n" } " is positive, or " { $snippet "-n" } " bits to the right if " { $snippet "n" } " is negative. A left shift of a fixnum may overflow, yielding a bignum. A right shift may result in bits ``falling off'' the right hand side and being discarded." } { $examples { $example "BIN: 101 5 shift .b" "10100000" } { $example "BIN: 11111 -2 shift .b" "111" } } ; HELP: bitnot From c1963dd4abd6566550c18edc73268898ca366fce Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 21 Jan 2008 15:33:43 -0500 Subject: [PATCH 06/15] I/O cleanups --- extra/io/nonblocking/nonblocking-docs.factor | 2 +- extra/io/nonblocking/nonblocking.factor | 30 +++++++++---------- extra/io/sniffer/bsd/bsd.factor | 2 +- extra/io/unix/backend/backend.factor | 31 +++++++++++++------- extra/io/unix/epoll/epoll.factor | 18 +++++------- extra/io/unix/kqueue/kqueue.factor | 20 +++++-------- extra/io/unix/select/select.factor | 2 +- extra/io/unix/sockets/sockets.factor | 21 ++++--------- extra/io/windows/ce/sockets/sockets.factor | 4 +-- extra/io/windows/nt/sockets/sockets.factor | 4 +-- 10 files changed, 62 insertions(+), 72 deletions(-) diff --git a/extra/io/nonblocking/nonblocking-docs.factor b/extra/io/nonblocking/nonblocking-docs.factor index 049c3bf497..c4adc3aa38 100644 --- a/extra/io/nonblocking/nonblocking-docs.factor +++ b/extra/io/nonblocking/nonblocking-docs.factor @@ -55,7 +55,7 @@ HELP: init-handle { $contract "Prepares a native handle for use by the port; called by " { $link } "." } ; HELP: -{ $values { "handle" "a native handle identifying an I/O resource" } { "buffer" "a " { $link buffer } " or " { $link f } } { "port" "a new " { $link port } } } +{ $values { "handle" "a native handle identifying an I/O resource" } { "buffer" "a " { $link buffer } " or " { $link f } } { "type" symbol } { "port" "a new " { $link port } } } { $description "Creates a new " { $link port } " using the specified native handle and I/O buffer." } $low-level-note ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index 9ff21aa011..9839cc7066 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -12,38 +12,36 @@ SYMBOL: default-buffer-size ! Common delegate of native stream readers and writers TUPLE: port handle error timeout cutoff type eof? ; -SYMBOL: input -SYMBOL: output SYMBOL: closed -PREDICATE: port input-port port-type input eq? ; -PREDICATE: port output-port port-type output eq? ; +PREDICATE: port input-port port-type input-port eq? ; +PREDICATE: port output-port port-type output-port eq? ; GENERIC: init-handle ( handle -- ) GENERIC: close-handle ( handle -- ) -: ( handle buffer -- port ) - over init-handle +: ( handle buffer type -- port ) + pick init-handle 0 0 { set-port-handle set-delegate + set-port-type set-port-timeout set-port-cutoff } port construct ; -: ( handle -- port ) - default-buffer-size get ; +: ( handle type -- port ) + default-buffer-size get swap ; : ( handle -- stream ) - input over set-port-type ; + input-port ; : ( handle -- stream ) - output over set-port-type ; + output-port ; : handle>duplex-stream ( in-handle out-handle -- stream ) - [ >r r> ] - [ ] [ stream-close ] + [ >r r> ] [ ] [ stream-close ] cleanup ; : touch-port ( port -- ) @@ -170,8 +168,8 @@ M: port stream-close TUPLE: server-port addr client ; -: ( port addr -- server ) - server-port pick set-port-type +: ( handle addr -- server ) + >r f server-port r> { set-delegate set-server-port-addr } server-port construct ; @@ -180,8 +178,8 @@ TUPLE: server-port addr client ; TUPLE: datagram-port addr packet packet-addr ; -: ( port addr -- datagram ) - datagram-port pick set-port-type +: ( handle addr -- datagram ) + >r f datagram-port r> { set-delegate set-datagram-port-addr } datagram-port construct ; diff --git a/extra/io/sniffer/bsd/bsd.factor b/extra/io/sniffer/bsd/bsd.factor index 5c32bd78d2..ae87c05d38 100644 --- a/extra/io/sniffer/bsd/bsd.factor +++ b/extra/io/sniffer/bsd/bsd.factor @@ -83,7 +83,7 @@ M: unix-io ( obj -- sniffer ) ] keep dupd sniffer-spec-ifname ioctl-sniffer-fd dup make-ioctl-buffer - input over set-port-type + input-port \ sniffer construct-delegate ] with-destructors ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 19856dc6be..6da26b5b67 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -18,19 +18,33 @@ TUPLE: io-task port callbacks ; >r 1vector io-task construct-boa r> construct-delegate ; inline +TUPLE: input-task ; + +: ( port continuation class -- task ) + >r input-task r> construct-delegate ; inline + +TUPLE: output-task ; + +: ( port continuation class -- task ) + >r output-task r> construct-delegate ; inline + GENERIC: do-io-task ( task -- ? ) GENERIC: io-task-container ( mx task -- hashtable ) ! I/O multiplexers TUPLE: mx fd reads writes ; +M: input-task io-task-container drop mx-reads ; + +M: output-task io-task-container drop mx-writes ; + : ( -- mx ) f H{ } clone H{ } clone mx construct-boa ; : construct-mx ( class -- obj ) swap construct-delegate ; GENERIC: register-io-task ( task mx -- ) GENERIC: unregister-io-task ( task mx -- ) -GENERIC: unix-io-multiplex ( ms mx -- ) +GENERIC: wait-for-events ( ms mx -- ) : fd/container ( task mx -- task fd container ) over io-task-container >r dup io-task-fd r> ; inline @@ -112,14 +126,12 @@ M: integer close-handle ( fd -- ) TUPLE: read-task ; : ( port continuation -- task ) - read-task ; + read-task ; M: read-task do-io-task io-task-port dup refill [ [ reader-eof ] [ drop ] if ] keep ; -M: read-task io-task-container drop mx-reads ; - M: input-port (wait-to-read) [ add-io-task stop ] callcc0 pending-error ; @@ -131,14 +143,12 @@ M: input-port (wait-to-read) TUPLE: write-task ; : ( port continuation -- task ) - write-task ; + write-task ; M: write-task do-io-task io-task-port dup buffer-empty? over port-error or [ 0 swap buffer-reset t ] [ write-step ] if ; -M: write-task io-task-container drop mx-writes ; - : add-write-io-task ( port continuation -- ) over port-handle mx get-global mx-writes at* [ io-task-callbacks push drop ] @@ -151,7 +161,7 @@ M: port port-flush ( port -- ) dup buffer-empty? [ drop ] [ (wait-to-write) ] if ; M: unix-io io-multiplex ( ms -- ) - mx get-global unix-io-multiplex ; + mx get-global wait-for-events ; M: unix-io init-stdio ( -- ) 0 1 handle>duplex-stream io:stdio set-global @@ -161,8 +171,7 @@ M: unix-io init-stdio ( -- ) TUPLE: mx-port mx ; : ( mx -- port ) - dup mx-fd f - mx-port over set-port-type + dup mx-fd f mx-port { set-mx-port-mx set-delegate } mx-port construct ; TUPLE: mx-task ; @@ -171,7 +180,7 @@ TUPLE: mx-task ; f io-task construct-boa mx-task construct-delegate ; M: mx-task do-io-task - io-task-port mx-port-mx 0 swap unix-io-multiplex f ; + io-task-port mx-port-mx 0 swap wait-for-events f ; : multiplexer-error ( n -- ) 0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ; diff --git a/extra/io/unix/epoll/epoll.factor b/extra/io/unix/epoll/epoll.factor index e39c35aca3..f2230f6e81 100644 --- a/extra/io/unix/epoll/epoll.factor +++ b/extra/io/unix/epoll/epoll.factor @@ -16,19 +16,15 @@ TUPLE: epoll-mx events ; max-events epoll_create dup io-error over set-mx-fd max-events "epoll-event" over set-epoll-mx-events ; -: io-task-filter ( task -- n ) - class { - { read-task [ EVFILT_READ ] } - { accept-task [ EVFILT_READ ] } - { receive-task [ EVFILT_READ ] } - { write-task [ EVFILT_WRITE ] } - { connect-task [ EVFILT_WRITE ] } - { send-task [ EVFILT_WRITE ] } - } case ; +GENERIC: io-task-events ( task -- n ) + +M: input-task drop EPOLLIN ; + +M: output-task drop EPOLLOUT ; : make-event ( task -- event ) "epoll-event" - tuck set-epoll-event-events + over io-task-events over set-epoll-event-events over io-task-fd over set-epoll-fd ; : do-epoll-ctl ( task mx what -- ) @@ -57,5 +53,5 @@ M: epoll-mx unregister-io-task ( task mx -- ) : handle-events ( mx n -- ) [ over epoll-mx-events kevent-nth handle-kevent ] with each ; -M: epoll-mx unix-io-multiplex ( ms mx -- ) +M: epoll-mx wait-for-events ( ms mx -- ) dup rot wait-kevent handle-kevents ; diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor index e1ce7666f1..4fbfbcaaf0 100644 --- a/extra/io/unix/kqueue/kqueue.factor +++ b/extra/io/unix/kqueue/kqueue.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.nonblocking io.unix.backend -io.unix.sockets sequences assocs unix unix.kqueue unix.process -math namespaces classes combinators threads vectors ; +sequences assocs unix unix.kqueue unix.process math namespaces +combinators threads vectors ; IN: io.unix.kqueue TUPLE: kqueue-mx events processes ; @@ -18,15 +18,11 @@ TUPLE: kqueue-mx events processes ; H{ } clone over set-kqueue-mx-processes max-events "kevent" over set-kqueue-mx-events ; -: io-task-filter ( task -- n ) - class { - { read-task [ EVFILT_READ ] } - { accept-task [ EVFILT_READ ] } - { receive-task [ EVFILT_READ ] } - { write-task [ EVFILT_WRITE ] } - { connect-task [ EVFILT_WRITE ] } - { send-task [ EVFILT_WRITE ] } - } case ; +GENERIC: io-task-filter ( task -- n ) + +M: input-task io-task-filter drop EVFILT_READ ; + +M: output-task io-task-filter drop EVFILT_WRITE ; : make-kevent ( task flags -- event ) "kevent" @@ -70,7 +66,7 @@ M: kqueue-mx unregister-io-task ( task mx -- ) : handle-kevents ( mx n -- ) [ over kqueue-mx-events kevent-nth handle-kevent ] with each ; -M: kqueue-mx unix-io-multiplex ( ms mx -- ) +M: kqueue-mx wait-for-events ( ms mx -- ) swap make-timespec dupd wait-kevent handle-kevents ; : make-proc-kevent ( pid -- kevent ) diff --git a/extra/io/unix/select/select.factor b/extra/io/unix/select/select.factor index e74324f3b6..c28686d2f2 100644 --- a/extra/io/unix/select/select.factor +++ b/extra/io/unix/select/select.factor @@ -40,7 +40,7 @@ TUPLE: select-mx read-fdset write-fdset ; write-fdset/tasks tuck init-fdset f ; -M: select-mx unix-io-multiplex ( ms mx -- ) +M: select-mx wait-for-events ( ms mx -- ) swap >r FD_SETSIZE over init-fdsets r> make-timeval select multiplexer-error dup read-fdset/tasks pick handle-fdset diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 81c0e50b42..35366b1d41 100644 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2007 Slava Pestov, Ivan Tikhonov. +! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. ! See http://factorcode.org/license.txt for BSD license. ! We need to fiddle with the exact search order here, since @@ -34,14 +34,12 @@ M: unix-io addrinfo-error ( n -- ) TUPLE: connect-task ; : ( port continuation -- task ) - connect-task ; + connect-task ; M: connect-task do-io-task io-task-port dup port-handle f 0 write 0 < [ defer-error ] [ drop t ] if ; -M: connect-task io-task-container drop mx-writes ; - : wait-to-connect ( port -- ) [ add-io-task stop ] callcc0 drop ; @@ -68,9 +66,7 @@ USE: unix TUPLE: accept-task ; : ( port continuation -- task ) - accept-task ; - -M: accept-task io-task-container drop mx-reads ; + accept-task ; : accept-sockaddr ( port -- fd sockaddr ) dup port-handle swap server-port-addr sockaddr-type @@ -101,7 +97,6 @@ M: unix-io ( addrspec -- stream ) [ SOCK_STREAM server-fd dup 10 listen zero? [ dup close (io-error) ] unless - f ] keep ; M: unix-io accept ( server -- client ) @@ -113,7 +108,7 @@ M: unix-io accept ( server -- client ) ! Datagram sockets - UDP and Unix domain M: unix-io - [ SOCK_DGRAM server-fd f ] keep ; + [ SOCK_DGRAM server-fd ] keep ; SYMBOL: receive-buffer @@ -139,7 +134,7 @@ packet-size receive-buffer set-global TUPLE: receive-task ; : ( stream continuation -- task ) - receive-task ; + receive-task ; M: receive-task do-io-task io-task-port @@ -152,8 +147,6 @@ M: receive-task do-io-task 2drop defer-error ] if ; -M: receive-task io-task-container drop mx-reads ; - : wait-receive ( stream -- ) [ add-io-task stop ] callcc0 drop ; @@ -170,7 +163,7 @@ M: unix-io receive ( datagram -- packet addrspec ) TUPLE: send-task packet sockaddr len ; : ( packet sockaddr len stream continuation -- task ) - send-task [ + send-task [ { set-send-task-packet set-send-task-sockaddr @@ -185,8 +178,6 @@ M: send-task do-io-task [ send-task-len do-send ] keep swap 0 < [ io-task-port defer-error ] [ drop t ] if ; -M: send-task io-task-container drop mx-writes ; - : wait-send ( packet sockaddr len stream -- ) [ add-io-task stop ] callcc0 2drop 2drop ; diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index da64b25933..cc19976bc5 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -38,7 +38,7 @@ M: windows-ce-io ( addrspec -- duplex-stream ) [ windows.winsock:SOCK_STREAM server-fd dup listen-on-socket - f + ] keep ; M: windows-ce-io accept ( server -- client ) @@ -58,7 +58,7 @@ M: windows-ce-io accept ( server -- client ) M: windows-ce-io ( addrspec -- datagram ) [ - windows.winsock:SOCK_DGRAM server-fd f + windows.winsock:SOCK_DGRAM server-fd ] keep ; : packet-size 65536 ; inline diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index e86f070719..a6c44a0b86 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -149,7 +149,7 @@ M: windows-nt-io ( addrspec -- server ) [ SOCK_STREAM server-fd dup listen-on-socket dup add-completion - f + ] keep ] with-destructors ; @@ -158,7 +158,7 @@ M: windows-nt-io ( addrspec -- datagram ) [ SOCK_DGRAM server-fd dup add-completion - f + ] keep ] with-destructors ; From 913403f06617a12fa080cb5208223ba6a66b5b21 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 21 Jan 2008 17:29:54 -0500 Subject: [PATCH 07/15] Load fix --- extra/io/nonblocking/nonblocking-docs.factor | 2 +- extra/io/nonblocking/nonblocking.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/io/nonblocking/nonblocking-docs.factor b/extra/io/nonblocking/nonblocking-docs.factor index c4adc3aa38..d0d5818bee 100644 --- a/extra/io/nonblocking/nonblocking-docs.factor +++ b/extra/io/nonblocking/nonblocking-docs.factor @@ -40,7 +40,7 @@ $nl { { $link port-error } " - the most recent I/O error, if any. This error is thrown to the waiting thread when " { $link pending-error } " is called by stream operations" } { { $link port-timeout } " - a timeout, specifying the maximum length of time, in milliseconds, for which input operations can block before throwing an error. A value of 0 denotes no timeout is desired." } { { $link port-cutoff } " - the time when the current timeout expires; if no input data arrives before this time, an error is thrown" } - { { $link port-type } " - a symbol identifying the port's intended purpose. Can be " { $link input } ", " { $link output } ", " { $link closed } ", or any other symbol" } + { { $link port-type } " - a symbol identifying the port's intended purpose" } { { $link port-eof? } " - a flag indicating if the port has reached the end of file while reading" } } } ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index 9839cc7066..8a7e732281 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -160,7 +160,7 @@ M: output-port stream-flush ( port -- ) M: port stream-close dup port-type closed eq? [ dup port-type >r closed over set-port-type r> - output eq? [ dup port-flush ] when + output-port eq? [ dup port-flush ] when dup port-handle close-handle dup delegate [ buffer-free ] when* f over set-delegate From 64d284a97041f65356a4a77ffc64da4f66995329 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 21 Jan 2008 17:30:10 -0500 Subject: [PATCH 08/15] Fix recompilation of foldable, flushable --- core/compiler/test/redefine.factor | 24 ++++++++++++++++++++++++ core/optimizer/backend/backend.factor | 11 ++++++----- core/words/words-tests.factor | 11 +++++++++++ core/words/words.factor | 2 +- 4 files changed, 42 insertions(+), 6 deletions(-) diff --git a/core/compiler/test/redefine.factor b/core/compiler/test/redefine.factor index 6e652df877..718e98c9c2 100755 --- a/core/compiler/test/redefine.factor +++ b/core/compiler/test/redefine.factor @@ -205,3 +205,27 @@ DEFER: generic-then-not-generic-test-2 [ ] [ "IN: temporary USE: math : generic-then-not-generic-test-1 1 + ;" eval ] unit-test [ 4 ] [ generic-then-not-generic-test-2 ] unit-test + +DEFER: foldable-test-2 + +[ ] [ "IN: temporary : foldable-test-1 3 ; foldable" eval ] unit-test + +[ ] [ "IN: temporary : foldable-test-2 foldable-test-1 ;" eval ] unit-test + +[ 3 ] [ foldable-test-2 ] unit-test + +[ ] [ "IN: temporary : foldable-test-1 4 ; foldable" eval ] unit-test + +[ 4 ] [ foldable-test-2 ] unit-test + +DEFER: flushable-test-2 + +[ ] [ "IN: temporary USE: kernel : flushable-test-1 drop 3 ; flushable" eval ] unit-test + +[ ] [ "IN: temporary USE: kernel : flushable-test-2 V{ } dup flushable-test-1 drop ;" eval ] unit-test + +[ V{ } ] [ flushable-test-2 ] unit-test + +[ ] [ "IN: temporary USING: kernel sequences ; : flushable-test-1 3 over push ;" eval ] unit-test + +[ V{ 3 } ] [ flushable-test-2 ] unit-test diff --git a/core/optimizer/backend/backend.factor b/core/optimizer/backend/backend.factor index 1122d83129..4843a9ff26 100644 --- a/core/optimizer/backend/backend.factor +++ b/core/optimizer/backend/backend.factor @@ -17,17 +17,17 @@ SYMBOL: optimizer-changed GENERIC: optimize-node* ( node -- node/t changed? ) -: ?union ( hash/f hash -- hash ) +: ?union ( assoc/f assoc -- hash ) over [ union ] [ nip ] if ; -: add-node-literals ( hash node -- ) +: add-node-literals ( assoc node -- ) over assoc-empty? [ 2drop ] [ [ node-literals ?union ] keep set-node-literals ] if ; -: add-node-classes ( hash node -- ) +: add-node-classes ( assoc node -- ) over assoc-empty? [ 2drop ] [ @@ -324,6 +324,7 @@ M: #dispatch optimize-node* ] if ; : flush-eval ( #call -- node ) + dup node-param +inlined+ depends-on dup node-out-d length f inline-literals ; : partial-eval? ( #call -- ? ) @@ -337,9 +338,9 @@ M: #dispatch optimize-node* dup node-in-d [ node-literal ] with map ; : partial-eval ( #call -- node ) + dup node-param +inlined+ depends-on dup literal-in-d over node-param 1quotation - [ with-datastack ] catch - [ 3drop t ] [ inline-literals ] if ; + [ with-datastack inline-literals ] [ 2drop 2drop t ] recover ; : define-identities ( words identities -- ) [ "identities" set-word-prop ] curry each ; diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index a88892b5f4..2455250dc9 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -175,3 +175,14 @@ SYMBOL: quot-uses-b [ t ] [ "symbol-generic" "temporary" lookup symbol? ] unit-test [ f ] [ "symbol-generic" "temporary" lookup generic? ] unit-test + +! Regressions +[ ] [ "IN: temporary : decl-forget-test ; foldable" eval ] unit-test +[ t ] [ "decl-forget-test" "temporary" lookup "foldable" word-prop ] unit-test +[ ] [ "IN: temporary : decl-forget-test ;" eval ] unit-test +[ f ] [ "decl-forget-test" "temporary" lookup "foldable" word-prop ] unit-test + +[ ] [ "IN: temporary : decl-forget-test ; flushable" eval ] unit-test +[ t ] [ "decl-forget-test" "temporary" lookup "flushable" word-prop ] unit-test +[ ] [ "IN: temporary : decl-forget-test ;" eval ] unit-test +[ f ] [ "decl-forget-test" "temporary" lookup "flushable" word-prop ] unit-test diff --git a/core/words/words.factor b/core/words/words.factor index a2d9234353..6d8bad4f9e 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -127,7 +127,7 @@ SYMBOL: changed-words : reset-word ( word -- ) { "unannotated-def" - "parsing" "inline" "foldable" + "parsing" "inline" "foldable" "flushable" "predicating" "reading" "writing" "constructing" From 1f2e4c88ed8a24a4127483ee0d39e5dc1aef2440 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 21 Jan 2008 17:30:19 -0500 Subject: [PATCH 09/15] Fix obsolete docs --- core/parser/parser-docs.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index de56dc55db..30e259c033 100755 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -44,8 +44,7 @@ ARTICLE: "vocabulary-search-errors" "Word lookup errors" "If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies. Then, one of three things happen:" { $list { "If there are no words having this name at all, an error is thrown and parsing stops." } - { "If there is exactly one vocabulary having a word with this name, the vocabulary is automatically added to the search path. This behavior is intended for interactive use and exploratory programming only, and production code should contain full " { $link POSTPONE: USING: } " declarations." } - { "If there is more than one vocabulary which contains a word with this name, a restartable error is thrown, with a restart for each vocabulary in question. The restarts add the vocabulary to the search path and continue parsing." } + { "If there are vocabularies which contain words with this name, a restartable error is thrown, with a restart for each vocabulary in question. The restarts add the vocabulary to the search path and continue parsing." } } "When writing a new vocabulary, one approach is to ignore " { $link POSTPONE: USING: } " declarations altogether, then to load the vocabulary and observe any parser notes and restarts and use this information to write the correct " { $link POSTPONE: USING: } " declaration." ; From e2ebe78915389fcff6eb54715ee66c3354b900ff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 21 Jan 2008 20:39:44 -0500 Subject: [PATCH 10/15] Faster bootstrap --- core/bootstrap/stage2.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index f9c738a8d0..d035744cd0 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -48,7 +48,11 @@ IN: bootstrap.stage2 "Compiling remaining words..." print flush - all-words [ compiled? not ] subset recompile-hook get call + "bootstrap.compiler" vocab [ + vocabs [ + words "compile" "compiler" lookup execute + ] each + ] when ] with-compiler-errors f error set-global From cc9646c80d0611d860e8cdcc60f4be9837a23bb5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 21 Jan 2008 20:39:49 -0500 Subject: [PATCH 11/15] Fix typo --- extra/io/nonblocking/nonblocking-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/nonblocking/nonblocking-docs.factor b/extra/io/nonblocking/nonblocking-docs.factor index d0d5818bee..d6d619229f 100644 --- a/extra/io/nonblocking/nonblocking-docs.factor +++ b/extra/io/nonblocking/nonblocking-docs.factor @@ -1,5 +1,5 @@ USING: io io.buffers io.backend help.markup help.syntax kernel -strings sbufs ; +strings sbufs words ; IN: io.nonblocking ARTICLE: "io.nonblocking" "Non-blocking I/O implementation" From 157043ad199b75d5b09b98fd56bf7519e95a2572 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 23 Jan 2008 02:45:55 -0400 Subject: [PATCH 12/15] Minor I/O backend tweak --- core/io/backend/backend.factor | 3 +++ extra/bootstrap/io/io.factor | 3 --- extra/io/unix/bsd/bsd.factor | 2 +- extra/io/unix/linux/linux.factor | 2 +- extra/io/windows/ce/ce.factor | 2 +- extra/io/windows/nt/nt.factor | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) mode change 100644 => 100755 core/io/backend/backend.factor mode change 100644 => 100755 extra/io/unix/bsd/bsd.factor mode change 100644 => 100755 extra/io/unix/linux/linux.factor diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor old mode 100644 new mode 100755 index a7736ae47e..6d0a6d5ec5 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -21,3 +21,6 @@ M: object normalize-pathname ; [ init-io embedded? [ init-stdio ] unless ] "io.backend" add-init-hook + +: set-io-backend ( backend -- ) + io-backend set-global init-io init-stdio ; diff --git a/extra/bootstrap/io/io.factor b/extra/bootstrap/io/io.factor index 238a971e67..065f7dd5c4 100755 --- a/extra/bootstrap/io/io.factor +++ b/extra/bootstrap/io/io.factor @@ -10,6 +10,3 @@ IN: bootstrap.io { [ wince? ] [ "windows.ce" ] } } cond append require ] when - -init-io -init-stdio diff --git a/extra/io/unix/bsd/bsd.factor b/extra/io/unix/bsd/bsd.factor old mode 100644 new mode 100755 index 8ed84dc305..39eb8b6fb9 --- a/extra/io/unix/bsd/bsd.factor +++ b/extra/io/unix/bsd/bsd.factor @@ -26,4 +26,4 @@ M: bsd-io init-io ( -- ) M: bsd-io wait-for-process ( pid -- status ) [ kqueue-mx get-global add-pid-task stop ] curry callcc1 ; -T{ bsd-io } io-backend set-global +T{ bsd-io } set-io-backend diff --git a/extra/io/unix/linux/linux.factor b/extra/io/unix/linux/linux.factor old mode 100644 new mode 100755 index 180e81e30a..34afc16246 --- a/extra/io/unix/linux/linux.factor +++ b/extra/io/unix/linux/linux.factor @@ -14,4 +14,4 @@ M: linux-io init-io ( -- ) M: linux-io wait-for-pid ( pid -- status ) [ kqueue-mx get-global add-pid-task stop ] curry callcc1 ; -T{ linux-io } io-backend set-global +T{ linux-io } set-io-backend diff --git a/extra/io/windows/ce/ce.factor b/extra/io/windows/ce/ce.factor index 9fb0d700d9..a5e0cb6b4a 100755 --- a/extra/io/windows/ce/ce.factor +++ b/extra/io/windows/ce/ce.factor @@ -3,4 +3,4 @@ io.windows.ce.files io.windows.ce.sockets io.windows.ce.launcher namespaces io.windows.mmap ; IN: io.windows.ce -T{ windows-ce-io } io-backend set-global +T{ windows-ce-io } set-io-backend diff --git a/extra/io/windows/nt/nt.factor b/extra/io/windows/nt/nt.factor index 9ec97b33c6..000d1362b6 100755 --- a/extra/io/windows/nt/nt.factor +++ b/extra/io/windows/nt/nt.factor @@ -9,4 +9,4 @@ USE: io.windows.mmap USE: io.backend USE: namespaces -T{ windows-nt-io } io-backend set-global +T{ windows-nt-io } set-io-backend From 81c5b413f489337abf9ea4255d21d4a0ccf23328 Mon Sep 17 00:00:00 2001 From: Slava Date: Wed, 23 Jan 2008 01:49:01 -0500 Subject: [PATCH 13/15] Working on epoll --- extra/io/unix/epoll/epoll.factor | 23 +++++++++++++---------- extra/io/unix/linux/linux.factor | 11 ++++++----- extra/io/unix/unix.factor | 4 ++-- extra/unix/linux/epoll/epoll.factor | 2 +- 4 files changed, 22 insertions(+), 18 deletions(-) diff --git a/extra/io/unix/epoll/epoll.factor b/extra/io/unix/epoll/epoll.factor index f2230f6e81..f0280aac78 100644 --- a/extra/io/unix/epoll/epoll.factor +++ b/extra/io/unix/epoll/epoll.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.nonblocking io.unix.backend -bit-arrays sequences assocs unix math namespaces structs ; +bit-arrays sequences assocs unix unix.linux.epoll math +namespaces structs ; IN: io.unix.epoll TUPLE: epoll-mx events ; @@ -18,17 +19,17 @@ TUPLE: epoll-mx events ; GENERIC: io-task-events ( task -- n ) -M: input-task drop EPOLLIN ; +M: input-task io-task-events drop EPOLLIN ; -M: output-task drop EPOLLOUT ; +M: output-task io-task-events drop EPOLLOUT ; : make-event ( task -- event ) "epoll-event" over io-task-events over set-epoll-event-events - over io-task-fd over set-epoll-fd ; + swap io-task-fd over set-epoll-event-fd ; : do-epoll-ctl ( task mx what -- ) - >r >r make-event r> mx-fd r> pick event-data *int roll + >r >r make-event r> mx-fd r> pick epoll-event-fd roll epoll_ctl io-error ; M: epoll-mx register-io-task ( task mx -- ) @@ -37,9 +38,9 @@ M: epoll-mx register-io-task ( task mx -- ) M: epoll-mx unregister-io-task ( task mx -- ) EPOLL_CTL_DEL do-epoll-ctl ; -: wait-kevent ( mx timeout -- n ) - >r mx-fd epoll-mx-events max-events r> epoll_wait - dup multiplexer-error ; +: wait-event ( mx timeout -- n ) + >r { mx-fd epoll-mx-events } get-slots max-events + r> epoll_wait dup multiplexer-error ; : epoll-read-task ( mx fd -- ) over mx-reads at* [ handle-io-task ] [ 2drop ] if ; @@ -51,7 +52,9 @@ M: epoll-mx unregister-io-task ( task mx -- ) epoll-event-fd 2dup epoll-read-task epoll-write-task ; : handle-events ( mx n -- ) - [ over epoll-mx-events kevent-nth handle-kevent ] with each ; + [ + over epoll-mx-events epoll-event-nth handle-event + ] with each ; M: epoll-mx wait-for-events ( ms mx -- ) - dup rot wait-kevent handle-kevents ; + dup rot wait-event handle-events ; diff --git a/extra/io/unix/linux/linux.factor b/extra/io/unix/linux/linux.factor index 180e81e30a..919fba8d5d 100644 --- a/extra/io/unix/linux/linux.factor +++ b/extra/io/unix/linux/linux.factor @@ -1,17 +1,18 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: io.unix.linux -USING: io.unix.backend io.unix.select namespaces kernel assocs ; +USING: io.backend io.unix.backend io.unix.launcher io.unix.epoll +namespaces kernel assocs unix.process ; TUPLE: linux-io ; INSTANCE: linux-io unix-io M: linux-io init-io ( -- ) - start-wait-loop - mx set-global ; + mx set-global + start-wait-loop ; -M: linux-io wait-for-pid ( pid -- status ) - [ kqueue-mx get-global add-pid-task stop ] curry callcc1 ; +M: linux-io wait-for-process ( pid -- status ) + wait-for-pid ; T{ linux-io } io-backend set-global diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor index d6d0a9cc22..7dc66a05ad 100755 --- a/extra/io/unix/unix.factor +++ b/extra/io/unix/unix.factor @@ -5,6 +5,6 @@ system vocabs.loader ; { { [ bsd? ] [ "io.unix.bsd" ] } { [ macosx? ] [ "io.unix.bsd" ] } - { [ linux? ] [ "io.unix.backend.linux" ] } - { [ solaris? ] [ "io.unix.backend.solaris" ] } + { [ linux? ] [ "io.unix.linux" ] } + { [ solaris? ] [ "io.unix.solaris" ] } } cond require diff --git a/extra/unix/linux/epoll/epoll.factor b/extra/unix/linux/epoll/epoll.factor index 946c387acc..6606c11568 100644 --- a/extra/unix/linux/epoll/epoll.factor +++ b/extra/unix/linux/epoll/epoll.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: unix.linux.epoll -USING: alien.syntax ; +USING: alien.syntax math ; FUNCTION: int epoll_create ( int size ) ; From 09eb56d0c2975a1f5182d721f200536f402f48fd Mon Sep 17 00:00:00 2001 From: Slava Date: Wed, 23 Jan 2008 03:07:15 -0500 Subject: [PATCH 14/15] epoll almost works --- core/io/backend/backend.factor | 4 ++-- extra/io/unix/epoll/epoll.factor | 8 +++++--- extra/io/unix/linux/linux.factor | 2 +- extra/unix/linux/epoll/epoll.factor | 3 ++- 4 files changed, 10 insertions(+), 7 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 6d0a6d5ec5..9aa1299871 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: init kernel system ; +USING: init kernel system namespaces ; IN: io.backend SYMBOL: io-backend diff --git a/extra/io/unix/epoll/epoll.factor b/extra/io/unix/epoll/epoll.factor index f0280aac78..1459549f9e 100644 --- a/extra/io/unix/epoll/epoll.factor +++ b/extra/io/unix/epoll/epoll.factor @@ -29,13 +29,15 @@ M: output-task io-task-events drop EPOLLOUT ; swap io-task-fd over set-epoll-event-fd ; : do-epoll-ctl ( task mx what -- ) - >r >r make-event r> mx-fd r> pick epoll-event-fd roll + >r mx-fd r> rot dup io-task-fd swap make-event epoll_ctl io-error ; M: epoll-mx register-io-task ( task mx -- ) - EPOLL_CTL_ADD do-epoll-ctl ; + 2dup EPOLL_CTL_ADD do-epoll-ctl + delegate register-io-task ; M: epoll-mx unregister-io-task ( task mx -- ) + 2dup delegate unregister-io-task EPOLL_CTL_DEL do-epoll-ctl ; : wait-event ( mx timeout -- n ) @@ -46,7 +48,7 @@ M: epoll-mx unregister-io-task ( task mx -- ) over mx-reads at* [ handle-io-task ] [ 2drop ] if ; : epoll-write-task ( mx fd -- ) - over mx-reads at* [ handle-io-task ] [ 2drop ] if ; + over mx-writes at* [ handle-io-task ] [ 2drop ] if ; : handle-event ( mx kevent -- ) epoll-event-fd 2dup epoll-read-task epoll-write-task ; diff --git a/extra/io/unix/linux/linux.factor b/extra/io/unix/linux/linux.factor index bd1d166252..56032ad019 100755 --- a/extra/io/unix/linux/linux.factor +++ b/extra/io/unix/linux/linux.factor @@ -15,4 +15,4 @@ M: linux-io init-io ( -- ) M: linux-io wait-for-process ( pid -- status ) wait-for-pid ; -T{ linux-io } set-io-backend +T{ linux-io } io-backend set-global ! set-io-backend diff --git a/extra/unix/linux/epoll/epoll.factor b/extra/unix/linux/epoll/epoll.factor index 6606c11568..c18fa2ee6c 100644 --- a/extra/unix/linux/epoll/epoll.factor +++ b/extra/unix/linux/epoll/epoll.factor @@ -9,7 +9,8 @@ FUNCTION: int epoll_ctl ( int epfd, int op, int fd, epoll_event* event ) ; C-STRUCT: epoll-event { "uint" "events" } - { "uint" "fd" } ; + { "uint" "fd" } + { "uint" "padding" } ; FUNCTION: int epoll_wait ( int epfd, epoll_event* events, int maxevents, int timeout ) ; From 42e97d4629fef0610c6fed0198ea6295f168962f Mon Sep 17 00:00:00 2001 From: Slava Date: Wed, 23 Jan 2008 03:30:16 -0500 Subject: [PATCH 15/15] epoll works but not for files; disable it for now --- extra/io/unix/linux/linux.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/io/unix/linux/linux.factor b/extra/io/unix/linux/linux.factor index 56032ad019..06380c7e1e 100755 --- a/extra/io/unix/linux/linux.factor +++ b/extra/io/unix/linux/linux.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: io.unix.linux -USING: io.backend io.unix.backend io.unix.launcher io.unix.epoll +USING: io.backend io.unix.backend io.unix.launcher io.unix.select namespaces kernel assocs unix.process ; TUPLE: linux-io ; @@ -9,10 +9,10 @@ TUPLE: linux-io ; INSTANCE: linux-io unix-io M: linux-io init-io ( -- ) - mx set-global + mx set-global start-wait-loop ; M: linux-io wait-for-process ( pid -- status ) wait-for-pid ; -T{ linux-io } io-backend set-global ! set-io-backend +T{ linux-io } set-io-backend