io.ports: some cleanup before optimizations.

db4
John Benediktsson 2014-11-20 16:19:39 -08:00
parent e55af0ebfe
commit f6ed37a6f7
1 changed files with 40 additions and 37 deletions

View File

@ -42,6 +42,8 @@ M: input-port stream-read1
dup check-disposed
dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
<PRIVATE
: read-step ( count port -- count ptr/f )
{
{ [ over 0 = ] [ 2drop 0 f ] }
@ -50,44 +52,36 @@ M: input-port stream-read1
} cond
{ fixnum c-ptr } declare ; inline
: prepare-read ( count stream -- count stream )
dup check-disposed [ 0 max >fixnum ] dip ; inline
: prepare-read ( count port -- count' port )
[ integer>fixnum-strict 0 max ] dip dup check-disposed ; inline
M: input-port stream-read-partial-unsafe ( n dst port -- count )
[ swap ] dip prepare-read read-step
[ swap [ memcpy ] keep ] [ 2drop 0 ] if* ;
:: read-loop ( n-remaining n-read port dst -- n-total )
n-remaining 0 > [
n-remaining port read-step :> ( n-buffered ptr )
ptr [
dst ptr n-buffered memcpy
n-remaining n-buffered - :> n-remaining'
n-read n-buffered + :> n-read'
n-buffered dst <displaced-alien> :> dst'
n-remaining' n-read' port dst' read-loop
] [ n-read ] if
] [ n-read ] if ; inline recursive
M:: input-port stream-read-unsafe ( n dst port -- count )
n port prepare-read :> ( n' port' )
n' port' read-step :> ( n-buffered ptr )
:: read-loop ( dst n-remaining port n-read -- n-total )
n-remaining port read-step :> ( n-buffered ptr )
ptr [
dst ptr n-buffered memcpy
n-buffered n' < [
n-buffered dst <displaced-alien> :> dst'
n' n-buffered - n-buffered port dst' read-loop
] [
n-buffered
] if
] [ 0 ] if ;
n-remaining n-buffered - :> n-remaining'
n-read n-buffered + :> n-read'
n-buffered dst <displaced-alien> :> dst'
dst' n-remaining' port n-read' read-loop
] [ n-read ] if ; inline recursive
: read-until-step ( separators port -- string/f separator/f )
PRIVATE>
M: input-port stream-read-partial-unsafe
swapd prepare-read read-step
[ swap [ memcpy ] keep ] [ 2drop 0 ] if* ;
M: input-port stream-read-unsafe
swapd prepare-read 0 read-loop ;
<PRIVATE
: read-until-step ( seps port -- byte-array/f sep/f )
dup wait-to-read [ 2drop f f ] [
buffer>> buffer-read-until
] if ; inline
: read-until-loop ( seps port accum -- separator/f )
: read-until-loop ( seps port accum -- sep/f )
2over read-until-step over [
[ append! ] dip dup [
[ 3drop ] dip
@ -98,7 +92,9 @@ M:: input-port stream-read-unsafe ( n dst port -- count )
[ 4drop ] dip
] if ; inline recursive
M: input-port stream-read-until ( seps port -- str/f sep/f )
PRIVATE>
M: input-port stream-read-until ( seps port -- byte-array/f sep/f )
2dup read-until-step dup [ [ 2drop ] 2dip ] [
over [
drop
@ -115,10 +111,14 @@ INSTANCE: output-port file-writer
HOOK: (wait-to-write) io-backend ( port -- )
<PRIVATE
: port-flush ( port -- )
dup buffer>> buffer-empty?
[ drop ] [ dup (wait-to-write) port-flush ] if ; inline recursive
PRIVATE>
M: output-port stream-flush
[ check-disposed ] [ port-flush ] bi ;
@ -131,6 +131,8 @@ M: output-port stream-write1
1 over wait-to-write
buffer>> buffer-write1 ; inline
<PRIVATE
:: port-write ( c-ptr n-remaining port -- )
port buffer>> :> buffer
n-remaining buffer size>> min :> n-write
@ -142,9 +144,11 @@ M: output-port stream-write1
n-write c-ptr <displaced-alien> swap port port-write
] [ drop ] if ; inline recursive
PRIVATE>
M: output-port stream-write
dup check-disposed
[ binary-object ] [ port-write ] bi* ;
[ binary-object integer>fixnum-strict ] [ port-write ] bi* ;
HOOK: tell-handle os ( handle -- n )
@ -229,12 +233,11 @@ M: object underlying-handle underlying-port handle>> ;
! Fast-path optimization
HINTS: (decode-until) { string input-port object } ;
HINTS: (decode-until)
{ string input-port object } ;
HINTS: M\ input-port stream-read-partial-unsafe
{ fixnum byte-array input-port }
{ fixnum string input-port } ;
{ fixnum byte-array object } ;
HINTS: M\ input-port stream-read-unsafe
{ fixnum byte-array input-port }
{ fixnum string input-port } ;
{ fixnum byte-array object } ;