more Unix I/O work

TODO.FACTOR.txt

@@ -8,9 +8,9 @@
 - powerpc has weird callstack residue
 - make-vector and make-string should not need a reverse step
 - console with presentations
-
 + plugin:
 
+- extract word: if selection empty, move caret to new word after
 - introduce quotation command
 - set 'end' of artifacts/assets accurately
 
@@ -96,7 +96,6 @@
 
 - regexps
 - XML
-- matrices, vector math
 - HTTP client
 - real Unicode support (strings are already 16 bits and can be extended
   to 21 if the need arises, but we need full character classification
@@ -108,3 +107,10 @@
 
 - virtual hosts
 - keep alive
+
++ matrix lib:
+
+- scalar * matrix, vector * matrix, matrix * vector need to work
+- turning vectors into row and column matrices
+- make-matrix is slow and ugly
+- move 2repeat somewhere else

library/sequences-epilogue.factor

@@ -91,7 +91,7 @@ M: sequence (tree-each) [ swap call ] seq-each-with ;
 : length= ( seq seq -- ? ) length swap length number= ;
 
 : (sequence=) ( seq seq i -- ? )
-    over length over = [
+    over length over number= [
         3drop t
     ] [
         3dup 2nth = [

library/unix/io.factor

@@ -1,16 +1,24 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: io-internals
-USING: errors generic kernel lists math namespaces sequences
+USING: errors generic hashtables kernel lists math namespaces
-strings vectors ;
+sequences strings threads vectors ;
 
+! These let us load the code into a CFactor instance using the
+! old C-based I/O. They will be removed soon.
 FORGET: can-read-line?
 FORGET: can-read-count?
 FORGET: can-write?
+FORGET: add-write-io-task
 
-TUPLE: io-task port callback ;
+TUPLE: io-task port callbacks ;
 GENERIC: do-io-task ( task -- ? )
+GENERIC: io-task-events ( task -- events )
 
+! A hashtable in the global namespace mapping fd numbers to
+! io-tasks. This is not a vector, since we need a quick way
+! to find the number of elements, and a hashtable gives us
+! this with the hash-size call.
 SYMBOL: io-tasks
 
 : file-mode OCT: 0600 ;
@@ -88,7 +96,7 @@ C: reader ( handle -- reader )
 
 TUPLE: read-line-task ;
 
-C: read-line-task ( port callback -- task )
+C: read-line-task ( port callbacks -- task )
     [ >r <io-task> r> set-delegate ] keep ;
 
 M: read-line-task do-io-task
@@ -98,6 +106,9 @@ M: read-line-task do-io-task
         read-line-step
     ] ifte ;
 
+M: read-line-task io-task-events ( task -- events )
+    drop read-events ;
+
 : read-count-step ( count reader -- ? )
     dup reader-line -rot >r over length - r>
     2dup buffer-fill <= [
@@ -116,16 +127,19 @@ M: read-line-task do-io-task
 
 TUPLE: read-task count ;
 
-C: read-task ( port callback -- task )
+C: read-task ( port callbacks -- task )
     [ >r <io-task> r> set-delegate ] keep ;
 
 M: read-task do-io-task
-    dup refill dup eof? [
+    io-task-port dup refill dup eof? [
         nip reader-eof t
     ] [
         read-count-step
     ] ifte ;
 
+M: read-task io-task-events ( task -- events )
+    drop read-events ;
+
 : pop-line ( reader -- str )
     dup reader-line dup [ sbuf>string ] when >r
     f over set-reader-line
@@ -159,16 +173,19 @@ C: writer ( fd -- writer )
 
 TUPLE: write-task ;
 
-C: write-task ( port callback -- task )
+C: write-task ( port callbacks -- task )
     [ >r <io-task> r> set-delegate ] keep ;
 
 M: write-task do-io-task
-    dup buffer-length 0 = over port-error or [
+    io-task-port dup buffer-length 0 = over port-error or [
         0 swap buffer-reset t
     ] [
         >port< write-step
     ] ifte ;
 
+M: write-task io-task-events ( task -- events )
+    drop write-events ;
+
 : write-fin ( str writer -- )
     dup pending-error
     >r dup string? [ ch>string ] unless r> >buffer ;
@@ -191,11 +208,68 @@ M: write-task do-io-task
         2drop f
     ] ifte ;
 
-: cons-nth ( elt n seq -- )
+: io-task-fd io-task-port port-handle ;
-    [ nth cons ] 2keep set-nth ;
 
 : add-io-task ( task -- )
-    dup io-task-port port-handle io-tasks get cons-nth ;
+    dup io-task-fd io-tasks get 2dup hash [
+        "Cannot perform multiple I/O ops on the same port" throw
+    ] when set-hash ;
+
+: add-write-io-task ( task -- )
+    dup io-task-fd io-tasks get hash [
+        dup write-task? [
+            [
+                >r io-task-callbacks r> io-task-callbacks append
+            ] keep set-io-task-callbacks
+        ] [
+            add-io-task
+        ] ifte
+    ] [
+        add-io-task
+    ] ifte* ;
+
+: remove-io-task ( task -- )
+    io-task-fd io-tasks get remove-hash ;
+
+: pop-callback ( task -- callback )
+    dup io-task-callbacks uncons dup [
+        rot set-io-task-callbacks
+    ] [
+        drop swap remove-io-task
+    ] ifte ;
+
+: handle-fd ( fd -- )
+    io-tasks get hash dup do-io-task [
+        pop-callback call
+    ] [
+        drop
+    ] ifte ;
+
+: do-io-tasks ( pollfds n -- )
+    [
+        dup pick pollfd-nth dup pollfd-revents 0 = [
+            drop
+        ] [
+            pollfd-fd handle-fd
+        ] ifte
+    ] repeat drop ;
+
+: init-pollfd ( task pollfd -- )
+    over io-task-fd over set-pollfd-fd
+    swap io-task-events swap set-pollfd-events ;
+
+: make-pollfds ( -- pollfds n )
+    io-tasks get dup hash-size [
+        <pollfd-array> swap hash-values [
+            dup io-task-fd pick pollfd-nth init-pollfd
+        ] each
+    ] keep ;
+
+: io-multiplexer ( -- )
+    make-pollfds dupd 0 sys-poll do-io-tasks ;
+
+: io-loop ( -- ) io-multiplexer yield io-loop ;
 
 : init-io ( -- )
-    global [ 100 <vector> io-tasks set ] bind ;
+    global [ <namespace> io-tasks set ] bind
+    [ io-loop ] in-thread ;

library/unix/syscalls.factor

@@ -105,5 +105,8 @@ END-STRUCT
 : POLLRDBAND HEX: 0080 ; ! OOB/Urgent readable data
 : POLLWRBAND HEX: 0100 ; ! OOB/Urgent data can be written
 
+: read-events POLLIN POLLRDNORM bitor POLLRDBAND bitor ;
+: write-events POLLOUT POLLWRNORM bitor POLLWRBAND bitor ;
+
 : sys-poll ( pollfds nfds timeout -- n )
     "int" "libc" "poll" [ "pollfd*" "uint" "int" ] alien-invoke ;