]> gitweb.factorcode.org Git - factor.git/commitdiff
fix bootstrap failure, unix i/o code no longer creates new sbufs all the time
authorSlava Pestov <slava@factorcode.org>
Wed, 20 Jul 2005 22:33:32 +0000 (22:33 +0000)
committerSlava Pestov <slava@factorcode.org>
Wed, 20 Jul 2005 22:33:32 +0000 (22:33 +0000)
TODO.FACTOR.txt
library/bootstrap/boot-stage1.factor
library/collections/growable.factor [new file with mode: 0644]
library/collections/sequences.factor
library/io/buffer.factor
library/unix/io.factor

index d53f2ca57c99bf9a8c56876fe8d3e37100672c3a..013418c070da8ce2e284f70d6ba6edff6b67a259 100644 (file)
@@ -1,7 +1,6 @@
 76:\r
 ---\r
 \r
-- i/o: don't keep creating new sbufs\r
 - fix listener prompt display after presentation commands invoked\r
 - theme abstraction in ui\r
 \r
index 090ffe6142c1ca82ccbcb82aa71b4489b108a6ca..8d1627573831ba2825a79d4b4c1f86dfa925b68c 100644 (file)
@@ -29,6 +29,7 @@ parser prettyprint sequences io vectors words ;
         "/library/math/float.factor"
         "/library/math/complex.factor"
 
+        "/library/collections/growable.factor"
         "/library/collections/cons.factor"
         "/library/collections/vectors.factor"
         "/library/collections/sequences-epilogue.factor"
diff --git a/library/collections/growable.factor b/library/collections/growable.factor
new file mode 100644 (file)
index 0000000..07ebffa
--- /dev/null
@@ -0,0 +1,46 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+
+! Some low-level code used by vectors and string buffers.
+IN: kernel-internals
+USING: errors kernel math math-internals sequences ;
+
+: assert-positive ( fx -- )
+    0 fixnum<
+    [ "Sequence index must be positive" throw ] when ; inline
+
+: assert-bounds ( fx seq -- )
+    over assert-positive
+    length fixnum>=
+    [ "Sequence index out of bounds" throw ] when ; inline
+
+: bounds-check ( n seq -- fixnum seq )
+    >r >fixnum r> 2dup assert-bounds ; inline
+
+: growable-check ( n seq -- fixnum seq )
+    >r >fixnum dup assert-positive r> ; inline
+
+GENERIC: underlying
+GENERIC: set-underlying
+GENERIC: set-capacity
+
+: expand ( len seq -- )
+    [ underlying resize ] keep set-underlying ;
+
+: ensure ( n seq -- )
+    #! If n is beyond the sequence's length, increase the length,
+    #! growing the underlying storage if necessary, with an
+    #! optimistic doubling of its size.
+    2dup length fixnum>= [
+        >r 1 fixnum+ r>
+        2dup underlying length fixnum> [
+            over 2 fixnum* over expand
+        ] when
+        set-capacity
+    ] [
+        2drop
+    ] ifte ;
+
+: grow-length ( len seq -- )
+    growable-check 2dup length > [ 2dup expand ] when
+    set-capacity ;
index 72b1e7102a155f80b5f281dba233db963c96e56c..7b4415e610d9334fe7798fa896a54215577618f7 100644 (file)
@@ -69,46 +69,3 @@ G: find* ( i seq quot -- i elt )
 
 : 3unseq ( { x y z } -- x y z )
     dup first over second rot third ;
-
-! Some low-level code used by vectors and string buffers.
-IN: kernel-internals
-
-: assert-positive ( fx -- )
-    0 fixnum<
-    [ "Sequence index must be positive" throw ] when ; inline
-
-: assert-bounds ( fx seq -- )
-    over assert-positive
-    length fixnum>=
-    [ "Sequence index out of bounds" throw ] when ; inline
-
-: bounds-check ( n seq -- fixnum seq )
-    >r >fixnum r> 2dup assert-bounds ; inline
-
-: growable-check ( n seq -- fixnum seq )
-    >r >fixnum dup assert-positive r> ; inline
-
-GENERIC: underlying
-GENERIC: set-underlying
-GENERIC: set-capacity
-
-: expand ( len seq -- )
-    [ underlying resize ] keep set-underlying ;
-
-: ensure ( n seq -- )
-    #! If n is beyond the sequence's length, increase the length,
-    #! growing the underlying storage if necessary, with an
-    #! optimistic doubling of its size.
-    2dup length fixnum>= [
-        >r 1 fixnum+ r>
-        2dup underlying length fixnum> [
-            over 2 fixnum* over expand
-        ] when
-        set-capacity
-    ] [
-        2drop
-    ] ifte ;
-
-: grow-length ( len seq -- )
-    growable-check 2dup length > [ 2dup expand ] when
-    set-capacity ;
index 0da40f7db51b7bed4682821ebedfdd105106c303..f2a63519dfa385e519908d72f4b69ac340c1a57e 100644 (file)
@@ -57,7 +57,7 @@ C: buffer ( size -- buffer )
     #! Returns the amount of data that may be added to the buffer.
     dup buffer-size swap buffer-fill - ;
 
-: eof? ( buffer -- ? ) buffer-fill 0 = ;
+: buffer-empty? ( buffer -- ? ) buffer-fill 0 = ;
 
 : buffer-extend ( length buffer -- )
     #! Increases the size of the buffer by length.
@@ -66,7 +66,7 @@ C: buffer ( size -- buffer )
 
 : check-overflow ( length buffer -- )
     2dup buffer-capacity > [
-        dup eof? [
+        dup buffer-empty? [
             buffer-extend
         ] [
             "Buffer overflow" throw
index 71fb3b78db97a3c97295d2a95373ecf05ce1c4e5..0fb22886d051e4463d4dbdf72279ac188e8bdbb7 100644 (file)
@@ -51,7 +51,7 @@ SYMBOL: write-tasks
 : init-handle ( fd -- ) F_SETFL O_NONBLOCK fcntl io-error ;
 
 ! Common delegate of native stream readers and writers
-TUPLE: port handle buffer error timeout cutoff output? sbuf ;
+TUPLE: port handle buffer error timeout cutoff output? sbuf eof? ;
 
 : make-buffer ( n -- buffer/f )
     dup 0 > [ <buffer> ] [ drop f ] ifte ;
@@ -60,7 +60,8 @@ C: port ( handle buffer -- port )
     [ 0 swap set-port-timeout ] keep
     [ 0 swap set-port-cutoff ] keep
     [ >r make-buffer r> set-delegate ] keep
-    [ >r dup init-handle r> set-port-handle ] keep ;
+    [ >r dup init-handle r> set-port-handle ] keep
+    80 <sbuf> over set-port-sbuf ;
 
 : touch-port ( port -- )
     dup port-timeout dup 0 =
@@ -158,19 +159,8 @@ GENERIC: task-container ( task -- vector )
 : open-read ( path -- fd )
     O_RDONLY file-mode open dup io-error ;
 
-: pop-line ( reader -- sbuf/f )
-    dup pending-error [ port-sbuf f ] keep set-port-sbuf ;
-
-: read-fin ( reader -- str ) pop-line dup [ >string ] when ;
-
-: init-reader ( count reader -- ) >r <sbuf> r> set-port-sbuf ;
-
 : reader-eof ( reader -- )
-    dup port-sbuf empty? [
-        f swap set-port-sbuf
-    ] [
-        drop
-    ] ifte ;
+    dup port-sbuf empty? [ t swap set-port-eof? ] [ drop ] ifte ;
 
 : (refill) ( port -- n )
     >port< dup buffer-end swap buffer-capacity read ;
@@ -197,7 +187,7 @@ GENERIC: task-container ( task -- vector )
     ] ifte ;
 
 : can-read-count? ( count reader -- ? )
-    dup pending-error 2dup init-reader read-step ;
+    dup pending-error 0 over port-sbuf set-length read-step ;
 
 TUPLE: read-task count ;
 
@@ -209,7 +199,7 @@ C: read-task ( count port -- task )
 
 M: read-task do-io-task ( task -- ? )
     >read-task< dup refill [
-        dup eof? [
+        dup buffer-empty? [
             reader-eof drop t
         ] [
             read-step
@@ -226,10 +216,12 @@ M: read-task task-container drop read-tasks get ;
     ] unless 2drop ;
 
 M: port stream-read ( count stream -- string )
-    [ wait-to-read ] keep read-fin ;
+    [ wait-to-read ] keep dup port-eof?
+    [ drop f ] [ port-sbuf >string ] ifte ;
 
 M: port stream-read1 ( stream -- char/f )
-    1 over wait-to-read port-sbuf first ;
+    1 over wait-to-read dup port-eof?
+    [ drop f ] [ port-sbuf first ] ifte ;
 
 ! Writers
 
@@ -251,7 +243,7 @@ M: port stream-read1 ( stream -- char/f )
     #! If the buffer is empty and the string is too long,
     #! extend the buffer.
     dup pending-error
-    dup eof? [
+    dup buffer-empty? [
         2drop t
     ] [
         [ buffer-fill + ] keep buffer-capacity <=