From ff780119fa1e5fdc7889b073a07930cf6cffe123 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Sun, 6 Aug 2006 00:14:14 +0000
Subject: [PATCH] Faster Unix stream-read1

---
 TODO.FACTOR.txt           |  5 -----
 library/io/unix/io.factor | 33 ++++++++++++++++++++++++++-------
 2 files changed, 26 insertions(+), 12 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4e84aae342..5432e77f30 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,7 +1,5 @@
 + 0.84:
 
-= bug fixes:
-
 - fix contribs: boids, automata
 - sometimes darcs get fails with the httpd
 - gdb triggers 'mutliple i/o ops on port' error
@@ -15,9 +13,6 @@
 - nasty inference regressions
 - [ [ dup call ] dup call ] infer hangs
 - the invalid recursion form case needs to be fixed, for inlines too
-
-= features:
-
 - graphical module manager tool
 - instead of decompiling words, add them to a 'recompile' set; compiler
   treats words in the recompile set as if they were not compiled
diff --git a/library/io/unix/io.factor b/library/io/unix/io.factor
index 2e1dc66172..3cbbb993a4 100644
--- a/library/io/unix/io.factor
+++ b/library/io/unix/io.factor
@@ -167,7 +167,7 @@ GENERIC: task-container ( task -- vector )
 
 : refill ( port -- ? )
     #! Return f if there is a recoverable error
-    dup buffer-length zero? [
+    dup buffer-empty? [
         dup (refill)  dup 0 >= [
             swap n>buffer t
         ] [
@@ -177,6 +177,30 @@ GENERIC: task-container ( task -- vector )
         drop t
     ] if ;
 
+! Reading a single character
+TUPLE: read1-task ;
+
+C: read1-task ( port -- task )
+    [ >r <io-task> r> set-delegate ] keep ;
+
+M: read1-task do-io-task ( task -- ? )
+    io-task-port dup refill [
+        [
+            dup buffer-empty?
+            [ t over set-port-eof? ] when
+        ] when drop
+    ] keep ;
+
+M: read1-task task-container drop read-tasks get-global ;
+
+: wait-to-read1 ( port -- )
+    dup buffer-empty? [
+        [ swap <read1-task> add-io-task stop ] callcc0
+    ] when pending-error ;
+
+M: input-port stream-read1 ( stream -- char/f )
+    dup wait-to-read1 dup port-eof? [ drop f ] [ buffer-pop ] if ;
+
 ! Reading character counts
 : read-step ( count reader -- ? )
     dup port-sbuf -rot >r over length - ( remaining) r>
@@ -187,7 +211,7 @@ GENERIC: task-container ( task -- vector )
     ] if ;
 
 : can-read-count? ( count reader -- ? )
-    dup pending-error 0 over port-sbuf set-length read-step ;
+    0 over port-sbuf set-length read-step ;
 
 TUPLE: read-task count ;
 
@@ -219,10 +243,6 @@ M: input-port stream-read ( count stream -- string )
     [ wait-to-read ] keep dup port-eof?
     [ drop f ] [ port-sbuf >string ] if ;
 
-M: input-port stream-read1 ( stream -- char/f )
-    1 over wait-to-read dup port-eof?
-    [ drop f ] [ port-sbuf first ] if ;
-
 ! Writers
 
 : open-write ( path -- fd )
@@ -242,7 +262,6 @@ M: input-port stream-read1 ( stream -- char/f )
 : can-write? ( len writer -- ? )
     #! If the buffer is empty and the string is too long,
     #! extend the buffer.
-    dup pending-error
     dup buffer-empty? [
         2drop t
     ] [