Implement monitors for BSD

extra/io/monitors/monitors-docs.factor

@@ -42,13 +42,17 @@ HELP: +rename-file-old+
 HELP: +rename-file-new+
 { $description "Indicates that a file has been renamed, and this is the new name." } ;
 
+HELP: +rename-file+
+{ $description "Indicates that a file has been renamed." } ;
+
 ARTICLE: "io.monitors.descriptors" "File system change descriptors"
 "Change descriptors output by " { $link next-change } ":"
 { $subsection +add-file+ }
 { $subsection +remove-file+ }
 { $subsection +modify-file+ }
 { $subsection +rename-file-old+ }
-{ $subsection +rename-file-new+ } ;
+{ $subsection +rename-file-new+ }
+{ $subsection +rename-file+ } ;
 
 ARTICLE: "io.monitors.platforms" "Monitors on different platforms"
 "Whether the " { $snippet "path" } " output value of " { $link next-change } " contains an absolute path or a path relative to the path given to " { $link <monitor> } " is platform-specific. User code should not assume either case."

extra/io/monitors/monitors-tests.factor

@@ -3,7 +3,7 @@ USING: io.monitors tools.test io.files system sequences
 continuations namespaces concurrency.count-downs kernel io
 threads calendar prettyprint ;
 
-os wince? [
+os { winnt linux macosx } member? [
     [
         [ "monitor-test" temp-file delete-tree ] ignore-errors
 
@@ -88,4 +88,4 @@ os wince? [
 
         [ ] [ "m" get dispose ] unit-test
     ] with-monitors
-] unless
+] when

extra/io/monitors/monitors.factor

@@ -45,6 +45,7 @@ SYMBOL: +remove-file+
 SYMBOL: +modify-file+
 SYMBOL: +rename-file-old+
 SYMBOL: +rename-file-new+
+SYMBOL: +rename-file+
 
 : with-monitor ( path recursive? quot -- )
     >r <monitor> r> with-disposal ; inline

extra/io/unix/backend/backend.factor

@@ -203,3 +203,6 @@ M: mx-task do-io-task
 
 : multiplexer-error ( n -- )
     0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ;
+
+: ?flag ( n mask symbol -- n )
+    pick rot bitand 0 > [ , ] [ drop ] if ;

extra/io/unix/bsd/bsd.factor

@@ -1,8 +1,21 @@
 ! 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.select
+USING: namespaces system kernel accessors assocs continuations
-namespaces system ;
+unix
+io.backend io.unix.backend io.unix.select io.unix.kqueue io.monitors ;
 
 M: bsd init-io ( -- )
-    <select-mx> mx set-global ;
+    <select-mx> mx set-global
+    <kqueue-mx> kqueue-mx set-global
+    kqueue-mx get-global <mx-port> <mx-task>
+    dup io-task-fd
+    [ mx get-global reads>> set-at ]
+    [ mx get-global writes>> set-at ] 2bi ;
+
+M: bsd init-monitors ;
+
+M: bsd dispose-monitors ;
+
+M: bsd (monitor) ( path recursive? mailbox -- )
+    nip <vnode-monitor> ;

extra/io/unix/kqueue/kqueue.factor

@@ -1,12 +1,14 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel io.nonblocking io.unix.backend
+USING: alien.c-types kernel math math.bitfields namespaces
-sequences assocs unix unix.time unix.kqueue unix.process math namespaces
+locals accessors combinators threads vectors hashtables
-combinators threads vectors io.launcher
+sequences assocs continuations
-io.unix.launcher ;
+unix unix.time unix.kqueue unix.process
+io.nonblocking io.unix.backend io.launcher io.unix.launcher
+io.monitors ;
 IN: io.unix.kqueue
 
-TUPLE: kqueue-mx events ;
+TUPLE: kqueue-mx events monitors ;
 
 : max-events ( -- n )
     #! We read up to 256 events at a time. This is an arbitrary
@@ -15,8 +17,9 @@ TUPLE: kqueue-mx events ;
 
 : <kqueue-mx> ( -- mx )
     kqueue-mx construct-mx
-    kqueue dup io-error over set-mx-fd
+        H{ } clone >>monitors
-    max-events "kevent" <c-array> over set-kqueue-mx-events ;
+        kqueue dup io-error >>fd
+        max-events "kevent" <c-array> >>events ;
 
 GENERIC: io-task-filter ( task -- n )
 
@@ -24,14 +27,19 @@ M: input-task io-task-filter drop EVFILT_READ ;
 
 M: output-task io-task-filter drop EVFILT_WRITE ;
 
+GENERIC: io-task-fflags ( task -- n )
+
+M: io-task io-task-fflags drop 0 ;
+
 : make-kevent ( task flags -- event )
     "kevent" <c-object>
     tuck set-kevent-flags
     over io-task-fd over set-kevent-ident
+    over io-task-fflags over set-kevent-fflags
     swap io-task-filter over set-kevent-filter ;
 
 : register-kevent ( kevent mx -- )
-    mx-fd swap 1 f 0 f kevent
+    fd>> swap 1 f 0 f kevent
     0 < [ err_no ESRCH = [ (io-error) ] unless ] when ;
 
 M: kqueue-mx register-io-task ( task mx -- )
@@ -43,33 +51,52 @@ M: kqueue-mx unregister-io-task ( task mx -- )
     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
+    >r [ fd>> f 0 ] keep events>> max-events r> kevent
     dup multiplexer-error ;
 
-: kevent-read-task ( mx fd -- )
+:: kevent-read-task ( mx fd kevent -- )
-    over mx-reads at handle-io-task ;
+    mx fd mx reads>> at handle-io-task ;
 
-: kevent-write-task ( mx fd -- )
+:: kevent-write-task ( mx fd kevent -- )
-    over mx-reads at handle-io-task ;
+    mx fd mx writes>> at handle-io-task ;
 
-: kevent-proc-task ( pid -- )
+:: kevent-proc-task ( mx pid kevent -- )
-    dup wait-for-pid swap find-process
+    pid wait-for-pid
+    pid find-process
     dup [ swap notify-exit ] [ 2drop ] if ;
 
+: parse-action ( mask -- changed )
+    [
+        NOTE_DELETE +remove-file+ ?flag
+        NOTE_WRITE +modify-file+ ?flag
+        NOTE_EXTEND +modify-file+ ?flag
+        NOTE_ATTRIB +modify-file+ ?flag
+        NOTE_RENAME +rename-file+ ?flag
+        NOTE_REVOKE +remove-file+ ?flag
+        drop
+    ] { } make prune ;
+
+:: kevent-vnode-task ( mx kevent fd -- )
+    ""
+    kevent kevent-fflags parse-action
+    fd mx monitors>> at queue-change ;
+
 : handle-kevent ( mx kevent -- )
-    dup kevent-ident swap kevent-filter {
+    [ ] [ kevent-ident ] [ kevent-filter ] tri {
         { [ dup EVFILT_READ = ] [ drop kevent-read-task ] }
         { [ dup EVFILT_WRITE = ] [ drop kevent-write-task ] }
-        { [ dup EVFILT_PROC = ] [ drop kevent-proc-task drop ] }
+        { [ dup EVFILT_PROC = ] [ drop kevent-proc-task ] }
+        { [ dup EVFILT_VNODE = ] [ drop kevent-vnode-task ] }
     } cond ;
 
 : handle-kevents ( mx n -- )
-    [ over kqueue-mx-events kevent-nth handle-kevent ] with each ;
+    [ over events>> kevent-nth handle-kevent ] with each ;
 
 M: kqueue-mx wait-for-events ( ms mx -- )
     swap dup [ make-timespec ] when
     dupd wait-kevent handle-kevents ;
 
+! Procs
 : make-proc-kevent ( pid -- kevent )
     "kevent" <c-object>
     tuck set-kevent-ident
@@ -77,5 +104,44 @@ M: kqueue-mx wait-for-events ( ms mx -- )
     EVFILT_PROC over set-kevent-filter
     NOTE_EXIT over set-kevent-fflags ;
 
-: add-pid-task ( pid mx -- )
+: register-pid-task ( pid mx -- )
     swap make-proc-kevent swap register-kevent ;
+
+! VNodes
+TUPLE: vnode-monitor < monitor fd ;
+
+: vnode-fflags ( -- n )
+    {
+        NOTE_DELETE
+        NOTE_WRITE
+        NOTE_EXTEND
+        NOTE_ATTRIB
+        NOTE_LINK
+        NOTE_RENAME
+        NOTE_REVOKE
+    } flags ;
+
+: make-vnode-kevent ( fd flags -- kevent )
+    "kevent" <c-object>
+    tuck set-kevent-flags
+    tuck set-kevent-ident
+    EVFILT_VNODE over set-kevent-filter
+    vnode-fflags over set-kevent-fflags ;
+
+: register-monitor ( monitor mx -- )
+    >r dup fd>> r>
+    [ >r EV_ADD EV_CLEAR bitor make-vnode-kevent r> register-kevent drop ]
+    [ monitors>> set-at ] 3bi ;
+
+: unregister-monitor ( monitor mx -- )
+    >r fd>> r>
+    [ monitors>> delete-at ]
+    [ >r EV_DELETE make-vnode-kevent r> register-kevent ] 2bi ;
+
+: <vnode-monitor> ( path mailbox -- monitor )
+    >r [ O_RDONLY 0 open dup io-error ] keep r>
+    vnode-monitor construct-monitor swap >>fd
+    [ dup kqueue-mx get register-monitor ] [ ] [ fd>> close ] cleanup ;
+
+M: vnode-monitor dispose
+    [ kqueue-mx get unregister-monitor ] [ fd>> close ] bi ;

extra/io/unix/linux/monitors/monitors.factor

@@ -55,9 +55,6 @@ M: linux-monitor dispose ( monitor -- )
     [ wd>> watches get delete-at ]
     [ wd>> inotify-fd swap inotify_rm_watch io-error ] bi ;
 
-: ?flag ( n mask symbol -- n )
-    pick rot bitand 0 > [ , ] [ drop ] if ;
-
 : ignore-flags? ( mask -- ? )
     {
         IN_DELETE_SELF
@@ -76,7 +73,7 @@ M: linux-monitor dispose ( monitor -- )
         IN_MOVED_FROM +rename-file-old+ ?flag
         IN_MOVED_TO +rename-file-new+ ?flag
         drop
-    ] { } make ;
+    ] { } make prune ;
 
 : parse-file-notify ( buffer -- path changed )
     dup inotify-event-mask ignore-flags? [