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
"/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"
--- /dev/null
+! 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 ;
: 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 ;
#! 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.
: check-overflow ( length buffer -- )
2dup buffer-capacity > [
- dup eof? [
+ dup buffer-empty? [
buffer-extend
] [
"Buffer overflow" throw
: 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 ;
[ 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 =
: 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 ;
] 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 ;
M: read-task do-io-task ( task -- ? )
>read-task< dup refill [
- dup eof? [
+ dup buffer-empty? [
reader-eof drop t
] [
read-step
] 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
#! 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 <=