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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.data alien.syntax USING: accessors alien.c-types alien.data alien.syntax
classes.struct combinators destructors destructors.private fry classes.struct combinators destructors destructors.private fry
hints io.backend io.backend.unix.multiplexers io.buffers io.backend io.backend.unix.multiplexers io.buffers io.files
io.files io.ports io.timeouts kernel kernel.private libc locals io.ports io.timeouts kernel kernel.private libc locals make math
make math namespaces sequences summary system threads unix namespaces sequences summary system threads unix unix.ffi
unix.ffi unix.stat unix.types ; unix.stat unix.types ;
QUALIFIED: io QUALIFIED: io
IN: io.backend.unix IN: io.backend.unix
@ -83,18 +83,21 @@ M: unix wait-for-fd ( handle event -- )
! Some general stuff ! 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 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 EINTR = ] [ 2drop +retry+ ] }
{ [ errno EAGAIN = ] [ 2drop +input+ ] } { [ errno EAGAIN = ] [ 2drop +input+ ] }
[ (io-error) ] [ (io-error) ]
} cond ; } cond ;
HINTS: M\ fd refill
{ buffered-port fd } ;
M: unix (wait-to-read) ( port -- ) M: unix (wait-to-read) ( port -- )
dup dup
dup handle>> dup check-disposed refill dup dup handle>> dup check-disposed refill dup
@ -102,11 +105,12 @@ M: unix (wait-to-read) ( port -- )
! Writers ! Writers
M: fd drain 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 >= ] [ { [ dup 0 >= ] [
over buffer>> buffer-consume over buffer-consume
buffer>> buffer-empty? f +output+ ? buffer-empty? f +output+ ?
] } ] }
{ [ errno EINTR = ] [ 2drop +retry+ ] } { [ errno EINTR = ] [ 2drop +retry+ ] }
{ [ errno EAGAIN = ] [ 2drop +output+ ] } { [ errno EAGAIN = ] [ 2drop +output+ ] }
@ -150,7 +154,7 @@ M: stdin dispose*
errno EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if errno EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if
] [ ] [
size = [ "Error reading stdin pipe" throw ] unless size = [ "Error reading stdin pipe" throw ] unless
size buffer n>buffer size buffer buffer+
] if ; ] if ;
M: stdin refill 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 USING: alien byte-arrays destructors help.markup help.syntax
kernel ; kernel math ;
IN: io.buffers IN: io.buffers
ARTICLE: "buffers" "Locked I/O buffers" ARTICLE: "buffers" "Locked I/O buffers"
@ -29,24 +29,27 @@ $nl
buffer-peek buffer-peek
buffer-pop buffer-pop
buffer-read buffer-read
buffer-read-unsafe
buffer-read-until
} }
"Writing to the buffer:" "Writing to the buffer:"
{ $subsections { $subsections
byte>buffer buffer-write1
>buffer buffer-write
n>buffer buffer+
} ; } ;
ABOUT: "buffers" ABOUT: "buffers"
HELP: buffer 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." { $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:"
$nl { $table
"Buffers have two internal pointers:" { { $slot "size" } "The total size, in bytes, of the buffer" }
{ $list { { $slot "ptr" } { "The " { $link c-ptr } " memory where data is stored" } }
{ { $snippet "fill" } " - the fill pointer, a write index where new data is added" } { { $slot "fill" } "The fill pointer, a write index where new data is added" }
{ { $snippet "pos" } " - the position, a read index where data is consumed" } { { $slot "pos" } "The position, a read index where data is consumed" }
} } ; }
} ;
HELP: <buffer> HELP: <buffer>
{ $values { "n" "a non-negative integer" } { "buffer" 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." } { $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 { $examples
{ $example { $example
"USING: destructors io.buffers kernel prettyprint ;" "USING: alien destructors io.buffers kernel prettyprint ;"
"5 100 <buffer> [ B{ 7 14 21 } over >buffer buffer-read ] with-disposal ." "5 100 <buffer> [ B{ 7 14 21 } binary-object pick buffer-write buffer-read ] with-disposal ."
"B{ 7 14 21 }" "B{ 7 14 21 }"
} }
} ; } ;
@ -84,8 +87,8 @@ HELP: buffer-length
{ $description "Outputs the number of unconsumed bytes in the buffer." } { $description "Outputs the number of unconsumed bytes in the buffer." }
{ $examples { $examples
{ $example { $example
"USING: destructors io.buffers kernel prettyprint ;" "USING: alien destructors io.buffers kernel prettyprint ;"
"100 <buffer> [ B{ 7 14 21 } over >buffer buffer-length ] with-disposal ." "100 <buffer> [ B{ 7 14 21 } binary-object pick buffer-write buffer-length ] with-disposal ."
"3" "3"
} }
} ; } ;
@ -105,24 +108,24 @@ HELP: buffer-empty?
{ $values { "buffer" buffer } { "?" boolean } } { $values { "buffer" buffer } { "?" boolean } }
{ $description "Tests if the buffer contains no more data to be read or written." } ; { $description "Tests if the buffer contains no more data to be read or written." } ;
HELP: >buffer HELP: buffer-write
{ $values { "byte-array" byte-array } { "buffer" buffer } } { $values { "c-ptr" c-ptr } { "n" fixnum } { "buffer" buffer } }
{ $description "Copies a byte array to the buffer's fill pointer, and advances it accordingly." } { $description "Copies a " { $link c-ptr } " 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." } ; { $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 } } { $values { "byte" "a byte" } { "buffer" buffer } }
{ $description "Appends a single byte to a buffer." } { $description "Appends a single byte to a buffer." }
{ $warning "This word will corrupt memory if the buffer is full." } { $warning "This word will corrupt memory if the buffer is full." }
{ $examples { $examples
{ $example { $example
"USING: destructors io.buffers kernel prettyprint ;" "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" "237"
} }
} ; } ;
HELP: n>buffer HELP: buffer+
{ $values { "n" "a non-negative integer" } { "buffer" buffer } } { $values { "n" "a non-negative integer" } { "buffer" buffer } }
{ $description "Advances the fill pointer by " { $snippet "n" } " bytes." } { $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." } ; { $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 world" ] [
"hello" 1024 <buffer> [ buffer-set ] keep "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 dup buffer-read-all >string swap dispose
] unit-test ] unit-test
@ -57,9 +57,9 @@ strings accessors destructors ;
"b" get dispose "b" get dispose
100 <buffer> "b" set 100 <buffer> "b" set
[ 1000 "b" get n>buffer >string ] must-fail [ 1000 "b" get buffer+ >string ] must-fail
"b" get dispose "b" get dispose
"hello world" string>buffer "b" set "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 "b" get dispose

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

@ -1,9 +1,9 @@
! Copyright (C) 2004, 2005 Mackenzie Straight. ! Copyright (C) 2004, 2005 Mackenzie Straight.
! Copyright (C) 2006, 2010 Slava Pestov. ! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors alien.c-types USING: accessors alien alien.accessors alien.data byte-arrays
alien.data alien.syntax kernel libc math sequences byte-arrays combinators destructors kernel libc math math.order sequences
strings hints math.order destructors combinators ; typed ;
IN: io.buffers IN: io.buffers
TUPLE: buffer TUPLE: buffer
@ -18,68 +18,60 @@ disposed ;
M: buffer dispose* ptr>> free ; inline M: buffer dispose* ptr>> free ; inline
: buffer-reset ( n buffer -- ) TYPED: buffer-reset ( n buffer: buffer -- )
swap >>fill 0 >>pos drop ; inline swap >>fill 0 >>pos drop ; inline
: buffer-capacity ( buffer -- n ) TYPED: buffer-capacity ( buffer: buffer -- n )
[ size>> ] [ fill>> ] bi - >fixnum ; inline [ size>> ] [ fill>> ] bi - >fixnum ; inline
: buffer-empty? ( buffer -- ? ) TYPED: buffer-empty? ( buffer: buffer -- ? )
fill>> zero? ; inline fill>> zero? ; inline
: buffer-consume ( n buffer -- ) TYPED: buffer-consume ( n: fixnum buffer: buffer -- )
[ + ] change-pos [ + ] change-pos
dup [ pos>> ] [ fill>> ] bi < dup [ pos>> ] [ fill>> ] bi <
[ 0 >>pos 0 >>fill ] unless drop ; inline [ 0 >>pos 0 >>fill ] unless drop ; inline
: buffer-peek ( buffer -- byte ) TYPED: buffer-peek ( buffer: buffer -- byte )
[ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline [ 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-peek ] [ 1 swap buffer-consume ] bi ; inline
: buffer-length ( buffer -- n ) TYPED: buffer-length ( buffer: buffer -- n )
[ fill>> ] [ pos>> ] bi - >fixnum ; inline [ fill>> ] [ pos>> ] bi - >fixnum ; inline
: buffer@ ( buffer -- alien ) TYPED: buffer@ ( buffer: buffer -- alien )
[ pos>> ] [ ptr>> ] bi <displaced-alien> ; inline [ 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-length min ] keep
[ buffer@ ] [ buffer-consume ] 2bi ; inline [ buffer@ ] [ buffer-consume ] 2bi ; inline
: buffer-read ( n buffer -- byte-array ) TYPED: buffer-read ( n: fixnum buffer: buffer -- byte-array )
buffer-read-unsafe swap memory>byte-array ; buffer-read-unsafe swap memory>byte-array ; inline
HINTS: buffer-read fixnum buffer ; TYPED: buffer-end ( buffer: buffer -- alien )
: buffer-end ( buffer -- alien )
[ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline [ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
: n>buffer ( n buffer -- ) TYPED: buffer+ ( n buffer: buffer -- )
[ + ] change-fill drop ; inline [ + ] 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 -- ) TYPED: buffer-write1 ( byte: fixnum buffer: buffer -- )
[ buffer-end swap binary-object memcpy ]
[ [ byte-length ] dip n>buffer ]
2bi ;
HINTS: >buffer byte-array buffer ;
: byte>buffer ( byte buffer -- )
[ >fixnum ] dip
[ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ] [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
[ 1 swap n>buffer ] [ 1 swap buffer+ ] bi ; inline
bi ; inline
: search-buffer-until ( pos fill ptr separators -- n ) <PRIVATE
: search-buffer-until ( pos fill ptr seps -- n )
[ iota ] 2dip [ iota ] 2dip
[ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry [ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry
find-from drop ; inline find-from drop ; inline
: finish-buffer-until ( buffer n -- byte-array separator ) : finish-buffer-until ( buffer n -- byte-array sep/f )
[ [
over pos>> - over pos>> -
over buffer-read over buffer-read
@ -89,9 +81,9 @@ HINTS: >buffer byte-array buffer ;
buffer-read f buffer-read f
] if* ; inline ] 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 swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip
search-buffer-until search-buffer-until
finish-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 ; } cleave ;
: finish-read ( n port -- ) : finish-read ( n port -- )
[ update-file-ptr ] [ buffer>> n>buffer ] 2bi ; [ update-file-ptr ] [ buffer>> buffer+ ] 2bi ;
M: object refill ( port handle -- event/f ) M: object refill ( port handle -- event/f )
[ make-FileArgs dup setup-read ReadFile ] [ 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 ! Copyright (C) 2005, 2010 Slava Pestov, Doug Coleman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.data byte-arrays USING: accessors alien byte-arrays combinators destructors hints
combinators destructors fry grouping hints io io.backend io io.backend io.buffers io.encodings io.files io.timeouts
io.buffers io.encodings io.files io.timeouts kernel kernel kernel.private libc locals math math.order namespaces
kernel.private libc locals math math.order namespaces sequences sequences strings system ;
strings system ;
IN: io.ports IN: io.ports
SYMBOL: default-buffer-size SYMBOL: default-buffer-size
@ -84,9 +83,11 @@ M:: input-port stream-read-unsafe ( n dst port -- count )
] [ 0 ] if ; ] [ 0 ] if ;
: read-until-step ( separators port -- string/f separator/f ) : 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 [ 2over read-until-step over [
[ append! ] dip dup [ [ append! ] dip dup [
[ 3drop ] dip [ 3drop ] dip
@ -95,7 +96,7 @@ M:: input-port stream-read-unsafe ( n dst port -- count )
] if ] if
] [ ] [
[ 4drop ] dip [ 4drop ] dip
] if ; ] if ; inline recursive
M: input-port stream-read-until ( seps port -- str/f sep/f ) M: input-port stream-read-until ( seps port -- str/f sep/f )
2dup read-until-step dup [ [ 2drop ] 2dip ] [ 2dup read-until-step dup [ [ 2drop ] 2dip ] [
@ -112,29 +113,6 @@ INSTANCE: output-port file-writer
: <output-port> ( handle -- output-port ) : <output-port> ( handle -- output-port )
output-port <buffered-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 -- ) HOOK: (wait-to-write) io-backend ( port -- )
: port-flush ( port -- ) : port-flush ( port -- )
@ -144,11 +122,36 @@ HOOK: (wait-to-write) io-backend ( port -- )
M: output-port stream-flush M: output-port stream-flush
[ check-disposed ] [ port-flush ] bi ; [ 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: tell-handle os ( handle -- n )
HOOK: seek-handle os ( n seek-type handle -- ) HOOK: seek-handle os ( n seek-type handle -- )
HOOK: can-seek-handle? os ( handle -- ? ) HOOK: can-seek-handle? os ( handle -- ? )
HOOK: handle-length os ( handle -- n/f ) HOOK: handle-length os ( handle -- n/f )
M: input-port stream-tell M: input-port stream-tell
@ -164,7 +167,7 @@ M: output-port stream-tell
! buffer. ! buffer.
seek-type seek-relative eq? seek-type seek-relative eq?
[ n stream stream-tell + seek-absolute ] [ n seek-type ] if [ n stream stream-tell + seek-absolute ] [ n seek-type ] if
stream ; stream ; inline
M: input-port stream-seek M: input-port stream-seek
do-seek-relative do-seek-relative
@ -209,8 +212,7 @@ M: port cancel-operation handle>> cancel-operation ;
M: port dispose* M: port dispose*
[ [
[ handle>> &dispose drop ] [ handle>> &dispose drop ]
[ handle>> shutdown ] [ handle>> shutdown ] bi
bi
] with-destructors ; ] with-destructors ;
GENERIC: underlying-port ( stream -- port ) GENERIC: underlying-port ( stream -- port )
@ -236,4 +238,3 @@ HINTS: M\ input-port stream-read-partial-unsafe
HINTS: M\ input-port stream-read-unsafe HINTS: M\ input-port stream-read-unsafe
{ fixnum byte-array input-port } { fixnum byte-array input-port }
{ fixnum string 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 ) : do-ssl-read ( buffer ssl -- event/f )
2dup swap [ buffer-end ] [ buffer-capacity ] bi SSL_read [ 2dup swap [ buffer-end ] [ buffer-capacity ] bi SSL_read [
{ { SSL_ERROR_ZERO_RETURN [ drop f ] } } check-ssl-error { { 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 ) M: ssl-handle refill ( port handle -- event/f )
dup maybe-handshake [ buffer>> ] [ handle>> ] bi* do-ssl-read ; 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 ) : (refill) ( stream -- err )
dup [ crypt-stream-handle ] keep [ buffer@ ] keep buffer-capacity 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 -- ) : refill ( stream -- )
dup (refill) check-read swap set-crypt-stream-eof? ; 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* ; 1 swap stream-read [ first ] [ f ] if* ;
: read-until-step ( seps stream -- sep/f ) : 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 % dup crypt-stream-eof? [ 2drop f ] [ read-until-step ] if
] if* ; ] if* ;
M: crypt-stream stream-read-until ( seps stream -- str/f sep/f ) 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 [ % read-until-step ] "" make f like swap
] if* ; ] if* ;