steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io.buffers: cleanup interface a bit.

db4
John Benediktsson 2014-11-16 18:54:24 -08:00
parent 60d0937041
commit f79d61060e
8 changed files with 113 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/io/backend/unix/unix.factor
View File

@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.data alien.syntax
classes.struct combinators destructors destructors.private fry
hints io.backend io.backend.unix.multiplexers io.buffers
io.files io.ports io.timeouts kernel kernel.private libc locals
make math namespaces sequences summary system threads unix
unix.ffi unix.stat unix.types ;
io.backend io.backend.unix.multiplexers io.buffers io.files
io.ports io.timeouts kernel kernel.private libc locals make math
namespaces sequences summary system threads unix unix.ffi
unix.stat unix.types ;
QUALIFIED: io
IN: io.backend.unix
@ -83,18 +83,21 @@ M: unix wait-for-fd ( handle event -- )
! Some general stuff
ERROR: not-a-buffered-port port ;
: check-buffered-port ( port -- port )
dup buffered-port? [ not-a-buffered-port ] unless ; inline
M: fd refill
fd>> over buffer>> [ buffer-end ] [ buffer-capacity ] bi read
[ check-buffered-port buffer>> ] [ fd>> ] bi*
over [ buffer-end ] [ buffer-capacity ] bi read
{
{ [ dup 0 >= ] [ swap buffer>> n>buffer f ] }
{ [ dup 0 >= ] [ swap buffer+ f ] }
{ [ errno EINTR = ] [ 2drop +retry+ ] }
{ [ errno EAGAIN = ] [ 2drop +input+ ] }
[ (io-error) ]
} cond ;
HINTS: M\ fd refill
{ buffered-port fd } ;
M: unix (wait-to-read) ( port -- )
dup
dup handle>> dup check-disposed refill dup
@ -102,11 +105,12 @@ M: unix (wait-to-read) ( port -- )
! Writers
M: fd drain
fd>> over buffer>> [ buffer@ ] [ buffer-length ] bi write
[ check-buffered-port buffer>> ] [ fd>> ] bi*
over [ buffer@ ] [ buffer-length ] bi write
{
{ [ dup 0 >= ] [
over buffer>> buffer-consume
buffer>> buffer-empty? f +output+ ?
over buffer-consume
buffer-empty? f +output+ ?
] }
{ [ errno EINTR = ] [ 2drop +retry+ ] }
{ [ errno EAGAIN = ] [ 2drop +output+ ] }
@ -150,7 +154,7 @@ M: stdin dispose*
errno EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if
] [
size = [ "Error reading stdin pipe" throw ] unless
size buffer n>buffer
size buffer buffer+
] if ;
M: stdin refill

47
basis/io/buffers/buffers-docs.factor
View File

@ -1,5 +1,5 @@
USING: alien byte-arrays destructors help.markup help.syntax
kernel ;
kernel math ;
IN: io.buffers
ARTICLE: "buffers" "Locked I/O buffers"
@ -29,24 +29,27 @@ $nl
buffer-peek
buffer-pop
buffer-read
buffer-read-unsafe
buffer-read-until
}
"Writing to the buffer:"
{ $subsections
byte>buffer
>buffer
n>buffer
buffer-write1
buffer-write
buffer+
} ;
ABOUT: "buffers"
HELP: buffer
{ $class-description "The class of I/O buffers, which resemble FIFO queues, but are optimized for holding bytes, are have underlying storage allocated at a fixed address. Buffers must be de-allocated manually."
$nl
"Buffers have two internal pointers:"
{ $list
{ { $snippet "fill" } " - the fill pointer, a write index where new data is added" }
{ { $snippet "pos" } " - the position, a read index where data is consumed" }
} } ;
{ $class-description "The class of I/O buffers, which resemble FIFO queues, but are optimized for holding bytes, are have underlying storage allocated at a fixed address. Buffers must be de-allocated manually. It has the following slots:"
{ $table
{ { $slot "size" } "The total size, in bytes, of the buffer" }
{ { $slot "ptr" } { "The " { $link c-ptr } " memory where data is stored" } }
{ { $slot "fill" } "The fill pointer, a write index where new data is added" }
{ { $slot "pos" } "The position, a read index where data is consumed" }
}
} ;
HELP: <buffer>
{ $values { "n" "a non-negative integer" } { "buffer" buffer } }
@ -73,8 +76,8 @@ HELP: buffer-read
{ $description "Collects a byte array of " { $snippet "n" } " bytes starting from the buffer's current position, and advances the position accordingly. If there are less than " { $snippet "n" } " bytes available, the output is truncated." }
{ $examples
{ $example
"USING: destructors io.buffers kernel prettyprint ;"
"5 100 <buffer> [ B{ 7 14 21 } over >buffer buffer-read ] with-disposal ."
"USING: alien destructors io.buffers kernel prettyprint ;"
"5 100 <buffer> [ B{ 7 14 21 } binary-object pick buffer-write buffer-read ] with-disposal ."
"B{ 7 14 21 }"
}
} ;
@ -84,8 +87,8 @@ HELP: buffer-length
{ $description "Outputs the number of unconsumed bytes in the buffer." }
{ $examples
{ $example
"USING: destructors io.buffers kernel prettyprint ;"
"100 <buffer> [ B{ 7 14 21 } over >buffer buffer-length ] with-disposal ."
"USING: alien destructors io.buffers kernel prettyprint ;"
"100 <buffer> [ B{ 7 14 21 } binary-object pick buffer-write buffer-length ] with-disposal ."
"3"
}
} ;
@ -105,24 +108,24 @@ HELP: buffer-empty?
{ $values { "buffer" buffer } { "?" boolean } }
{ $description "Tests if the buffer contains no more data to be read or written." } ;
HELP: >buffer
{ $values { "byte-array" byte-array } { "buffer" buffer } }
{ $description "Copies a byte array to the buffer's fill pointer, and advances it accordingly." }
{ $warning "This word will corrupt memory if the byte array is larger than the space available in the buffer." } ;
HELP: buffer-write
{ $values { "c-ptr" c-ptr } { "n" fixnum } { "buffer" buffer } }
{ $description "Copies a " { $link c-ptr } " to the buffer's fill pointer, and advances it accordingly." }
{ $warning "This word will corrupt memory if writing more than the space available in the buffer." } ;
HELP: byte>buffer
HELP: buffer-write1
{ $values { "byte" "a byte" } { "buffer" buffer } }
{ $description "Appends a single byte to a buffer." }
{ $warning "This word will corrupt memory if the buffer is full." }
{ $examples
{ $example
"USING: destructors io.buffers kernel prettyprint ;"
"100 <buffer> [ 237 over byte>buffer buffer-pop ] with-disposal ."
"100 <buffer> [ 237 over buffer-write1 buffer-pop ] with-disposal ."
"237"
}
} ;
HELP: n>buffer
HELP: buffer+
{ $values { "n" "a non-negative integer" } { "buffer" buffer } }
{ $description "Advances the fill pointer by " { $snippet "n" } " bytes." }
{ $warning "This word will leave the buffer in an invalid state if it does not have " { $snippet "n" } " bytes available." } ;

6
basis/io/buffers/buffers-tests.factor
View File

@ -43,7 +43,7 @@ strings accessors destructors ;
[ "hello world" ] [
"hello" 1024 <buffer> [ buffer-set ] keep
" world" >byte-array over >buffer
" world" >byte-array binary-object pick buffer-write
dup buffer-read-all >string swap dispose
] unit-test
@ -57,9 +57,9 @@ strings accessors destructors ;
"b" get dispose
100 <buffer> "b" set
[ 1000 "b" get n>buffer >string ] must-fail
[ 1000 "b" get buffer+ >string ] must-fail
"b" get dispose
"hello world" string>buffer "b" set
[ "hello" CHAR: \s ] [ " " "b" get buffer-until [ >string ] dip ] unit-test
[ "hello" CHAR: \s ] [ " " "b" get buffer-read-until [ >string ] dip ] unit-test
"b" get dispose

62
basis/io/buffers/buffers.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2004, 2005 Mackenzie Straight.
! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors alien.c-types
alien.data alien.syntax kernel libc math sequences byte-arrays
strings hints math.order destructors combinators ;
USING: accessors alien alien.accessors alien.data byte-arrays
combinators destructors kernel libc math math.order sequences
typed ;
IN: io.buffers
TUPLE: buffer
@ -18,68 +18,60 @@ disposed ;
M: buffer dispose* ptr>> free ; inline
: buffer-reset ( n buffer -- )
TYPED: buffer-reset ( n buffer: buffer -- )
swap >>fill 0 >>pos drop ; inline
: buffer-capacity ( buffer -- n )
TYPED: buffer-capacity ( buffer: buffer -- n )
[ size>> ] [ fill>> ] bi - >fixnum ; inline
: buffer-empty? ( buffer -- ? )
TYPED: buffer-empty? ( buffer: buffer -- ? )
fill>> zero? ; inline
: buffer-consume ( n buffer -- )
TYPED: buffer-consume ( n: fixnum buffer: buffer -- )
[ + ] change-pos
dup [ pos>> ] [ fill>> ] bi <
[ 0 >>pos 0 >>fill ] unless drop ; inline
: buffer-peek ( buffer -- byte )
TYPED: buffer-peek ( buffer: buffer -- byte )
[ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
: buffer-pop ( buffer -- byte )
TYPED: buffer-pop ( buffer: buffer -- byte )
[ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
: buffer-length ( buffer -- n )
TYPED: buffer-length ( buffer: buffer -- n )
[ fill>> ] [ pos>> ] bi - >fixnum ; inline
: buffer@ ( buffer -- alien )
TYPED: buffer@ ( buffer: buffer -- alien )
[ pos>> ] [ ptr>> ] bi <displaced-alien> ; inline
: buffer-read-unsafe ( n buffer -- n ptr )
TYPED: buffer-read-unsafe ( n: fixnum buffer: buffer -- n ptr )
[ buffer-length min ] keep
[ buffer@ ] [ buffer-consume ] 2bi ; inline
: buffer-read ( n buffer -- byte-array )
buffer-read-unsafe swap memory>byte-array ;
TYPED: buffer-read ( n: fixnum buffer: buffer -- byte-array )
buffer-read-unsafe swap memory>byte-array ; inline
HINTS: buffer-read fixnum buffer ;
: buffer-end ( buffer -- alien )
TYPED: buffer-end ( buffer: buffer -- alien )
[ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
: n>buffer ( n buffer -- )
TYPED: buffer+ ( n buffer: buffer -- )
[ + ] change-fill drop ; inline
HINTS: n>buffer fixnum buffer ;
TYPED: buffer-write ( c-ptr n buffer: buffer -- )
[ buffer-end -rot memcpy ] [ buffer+ ] 2bi ; inline
: >buffer ( byte-array buffer -- )
[ buffer-end swap binary-object memcpy ]
[ [ byte-length ] dip n>buffer ]
2bi ;
HINTS: >buffer byte-array buffer ;
: byte>buffer ( byte buffer -- )
[ >fixnum ] dip
TYPED: buffer-write1 ( byte: fixnum buffer: buffer -- )
[ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
[ 1 swap n>buffer ]
bi ; inline
[ 1 swap buffer+ ] bi ; inline
: search-buffer-until ( pos fill ptr separators -- n )
<PRIVATE
: search-buffer-until ( pos fill ptr seps -- n )
[ iota ] 2dip
[ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry
find-from drop ; inline
: finish-buffer-until ( buffer n -- byte-array separator )
: finish-buffer-until ( buffer n -- byte-array sep/f )
[
over pos>> -
over buffer-read
@ -89,9 +81,9 @@ HINTS: >buffer byte-array buffer ;
buffer-read f
] if* ; inline
: buffer-until ( separators buffer -- byte-array separator )
PRIVATE>
TYPED: buffer-read-until ( seps buffer: buffer -- byte-array sep/f )
swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip
search-buffer-until
finish-buffer-until ;
HINTS: buffer-until { string buffer } ;

2
basis/io/files/windows/windows.factor
View File

@ -194,7 +194,7 @@ M: object drain ( port handle -- event/f )
} cleave ;
: finish-read ( n port -- )
[ update-file-ptr ] [ buffer>> n>buffer ] 2bi ;
[ update-file-ptr ] [ buffer>> buffer+ ] 2bi ;
M: object refill ( port handle -- event/f )
[ make-FileArgs dup setup-read ReadFile ]

71
basis/io/ports/ports.factor
View File

@ -1,10 +1,9 @@
! Copyright (C) 2005, 2010 Slava Pestov, Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.data byte-arrays
combinators destructors fry grouping hints io io.backend
io.buffers io.encodings io.files io.timeouts kernel
kernel.private libc locals math math.order namespaces sequences
strings system ;
USING: accessors alien byte-arrays combinators destructors hints
io io.backend io.buffers io.encodings io.files io.timeouts
kernel kernel.private libc locals math math.order namespaces
sequences strings system ;
IN: io.ports
SYMBOL: default-buffer-size
@ -84,9 +83,11 @@ M:: input-port stream-read-unsafe ( n dst port -- count )
] [ 0 ] if ;
: read-until-step ( separators port -- string/f separator/f )
dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
dup wait-to-read [ 2drop f f ] [
buffer>> buffer-read-until
] if ; inline
: read-until-loop ( seps port buf -- separator/f )
: read-until-loop ( seps port accum -- separator/f )
2over read-until-step over [
[ append! ] dip dup [
[ 3drop ] dip
@ -95,7 +96,7 @@ M:: input-port stream-read-unsafe ( n dst port -- count )
] if
] [
[ 4drop ] dip
] if ;
] if ; inline recursive
M: input-port stream-read-until ( seps port -- str/f sep/f )
2dup read-until-step dup [ [ 2drop ] 2dip ] [
@ -112,29 +113,6 @@ INSTANCE: output-port file-writer
: <output-port> ( handle -- output-port )
output-port <buffered-port> ;
: wait-to-write ( len port -- )
[ nip ] [ buffer>> buffer-capacity <= ] 2bi
[ drop ] [ stream-flush ] if ; inline
M: output-port stream-write1
dup check-disposed
1 over wait-to-write
buffer>> byte>buffer ; inline
: write-in-groups ( byte-array port -- )
[ binary-object uchar <c-direct-array> ] dip
[ buffer>> size>> <groups> ] [ '[ _ stream-write ] ] bi
each ; inline
M: output-port stream-write
dup check-disposed
2dup [ byte-length ] [ buffer>> size>> ] bi* > [
write-in-groups
] [
[ [ byte-length ] dip wait-to-write ]
[ buffer>> >buffer ] 2bi
] if ;
HOOK: (wait-to-write) io-backend ( port -- )
: port-flush ( port -- )
@ -144,11 +122,36 @@ HOOK: (wait-to-write) io-backend ( port -- )
M: output-port stream-flush
[ check-disposed ] [ port-flush ] bi ;
: wait-to-write ( len port -- )
[ nip ] [ buffer>> buffer-capacity <= ] 2bi
[ drop ] [ port-flush ] if ; inline
M: output-port stream-write1
dup check-disposed
1 over wait-to-write
buffer>> buffer-write1 ; inline
:: port-write ( c-ptr n-remaining port -- )
port buffer>> :> buffer
n-remaining buffer size>> min :> n-write
n-write port wait-to-write
c-ptr n-write buffer buffer-write
n-remaining n-write - dup 0 > [
n-write c-ptr <displaced-alien> swap port port-write
] [ drop ] if ; inline recursive
M: output-port stream-write
dup check-disposed
[ binary-object ] [ port-write ] bi* ;
HOOK: tell-handle os ( handle -- n )
HOOK: seek-handle os ( n seek-type handle -- )
HOOK: can-seek-handle? os ( handle -- ? )
HOOK: handle-length os ( handle -- n/f )
M: input-port stream-tell
@ -164,7 +167,7 @@ M: output-port stream-tell
! buffer.
seek-type seek-relative eq?
[ n stream stream-tell + seek-absolute ] [ n seek-type ] if
stream ;
stream ; inline
M: input-port stream-seek
do-seek-relative
@ -209,8 +212,7 @@ M: port cancel-operation handle>> cancel-operation ;
M: port dispose*
[
[ handle>> &dispose drop ]
[ handle>> shutdown ]
bi
[ handle>> shutdown ] bi
] with-destructors ;
GENERIC: underlying-port ( stream -- port )
@ -236,4 +238,3 @@ HINTS: M\ input-port stream-read-partial-unsafe
HINTS: M\ input-port stream-read-unsafe
{ fixnum byte-array input-port }
{ fixnum string input-port } ;

2
basis/io/sockets/secure/openssl/openssl.factor
View File

@ -228,7 +228,7 @@ SYMBOL: default-secure-context
: do-ssl-read ( buffer ssl -- event/f )
2dup swap [ buffer-end ] [ buffer-capacity ] bi SSL_read [
{ { SSL_ERROR_ZERO_RETURN [ drop f ] } } check-ssl-error
] keep swap [ 2nip ] [ swap n>buffer f ] if* ;
] keep swap [ 2nip ] [ swap buffer+ f ] if* ;
M: ssl-handle refill ( port handle -- event/f )
dup maybe-handshake [ buffer>> ] [ handle>> ] bi* do-ssl-read ;

6
unmaintained/cryptlib/streams/streams.factor
View File

@ -39,7 +39,7 @@ TUPLE: crypt-stream handle eof? ;
: (refill) ( stream -- err )
dup [ crypt-stream-handle ] keep [ buffer@ ] keep buffer-capacity
"int" <c-object> dup >r cryptPopData r> *int rot n>buffer ;
"int" <c-object> dup >r cryptPopData r> *int rot buffer+ ;
: refill ( stream -- )
dup (refill) check-read swap set-crypt-stream-eof? ;
@ -61,13 +61,13 @@ M: crypt-stream stream-read1 ( stream -- ch/f )
1 swap stream-read [ first ] [ f ] if* ;
: read-until-step ( seps stream -- sep/f )
dup refill 2dup buffer-until [ swap % 2nip ]
dup refill 2dup buffer-read-until [ swap % 2nip ]
[
% dup crypt-stream-eof? [ 2drop f ] [ read-until-step ] if
] if* ;
M: crypt-stream stream-read-until ( seps stream -- str/f sep/f )
2dup buffer-until [ >r 2nip r> ] [
2dup buffer-read-until [ >r 2nip r> ] [
[ % read-until-step ] "" make f like swap
] if* ;