io.ports: use fixnum where possible, assert c-ptr since we use memcpy.

db4
John Benediktsson 2014-11-20 17:19:16 -08:00
parent f6ed37a6f7
commit 25f3032d04
1 changed files with 20 additions and 19 deletions

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien byte-arrays combinators destructors hints USING: accessors alien byte-arrays combinators destructors hints
io io.backend io.buffers io.encodings io.files io.timeouts io io.backend io.buffers io.encodings io.files io.timeouts
kernel kernel.private libc locals math math.order namespaces kernel kernel.private libc locals math math.order math.private
sequences strings system ; namespaces sequences strings system ;
IN: io.ports IN: io.ports
SYMBOL: default-buffer-size SYMBOL: default-buffer-size
@ -42,6 +42,11 @@ M: input-port stream-read1
dup check-disposed dup check-disposed
dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
ERROR: not-a-c-ptr object ;
: check-c-ptr ( c-ptr -- c-ptr )
dup c-ptr? [ not-a-c-ptr ] unless ; inline
<PRIVATE <PRIVATE
: read-step ( count port -- count ptr/f ) : read-step ( count port -- count ptr/f )
@ -59,8 +64,8 @@ M: input-port stream-read1
n-remaining port read-step :> ( n-buffered ptr ) n-remaining port read-step :> ( n-buffered ptr )
ptr [ ptr [
dst ptr n-buffered memcpy dst ptr n-buffered memcpy
n-remaining n-buffered - :> n-remaining' n-remaining n-buffered fixnum-fast :> n-remaining'
n-read n-buffered + :> n-read' n-read n-buffered fixnum+fast :> n-read'
n-buffered dst <displaced-alien> :> dst' n-buffered dst <displaced-alien> :> dst'
dst' n-remaining' port n-read' read-loop dst' n-remaining' port n-read' read-loop
] [ n-read ] if ; inline recursive ] [ n-read ] if ; inline recursive
@ -68,11 +73,11 @@ M: input-port stream-read1
PRIVATE> PRIVATE>
M: input-port stream-read-partial-unsafe M: input-port stream-read-partial-unsafe
swapd prepare-read read-step [ check-c-ptr swap ] dip prepare-read read-step
[ swap [ memcpy ] keep ] [ 2drop 0 ] if* ; [ swap [ memcpy ] keep ] [ 2drop 0 ] if* ;
M: input-port stream-read-unsafe M: input-port stream-read-unsafe
swapd prepare-read 0 read-loop ; [ check-c-ptr swap ] dip prepare-read 0 read-loop ;
<PRIVATE <PRIVATE
@ -94,7 +99,7 @@ M: input-port stream-read-unsafe
PRIVATE> PRIVATE>
M: input-port stream-read-until ( seps port -- byte-array/f sep/f ) M: input-port stream-read-until
2dup read-until-step dup [ [ 2drop ] 2dip ] [ 2dup read-until-step dup [ [ 2drop ] 2dip ] [
over [ over [
drop drop
@ -127,9 +132,9 @@ M: output-port stream-flush
[ drop ] [ port-flush ] if ; inline [ drop ] [ port-flush ] if ; inline
M: output-port stream-write1 M: output-port stream-write1
dup check-disposed [ check-disposed ]
1 over wait-to-write [ 1 swap wait-to-write ]
buffer>> buffer-write1 ; inline [ buffer>> buffer-write1 ] tri ; inline
<PRIVATE <PRIVATE
@ -140,15 +145,17 @@ M: output-port stream-write1
n-write port wait-to-write n-write port wait-to-write
c-ptr n-write buffer buffer-write c-ptr n-write buffer buffer-write
n-remaining n-write - dup 0 > [ n-remaining n-write fixnum-fast dup 0 > [
n-write c-ptr <displaced-alien> swap port port-write n-write c-ptr <displaced-alien> swap port port-write
] [ drop ] if ; inline recursive ] [ drop ] if ; inline recursive
PRIVATE> PRIVATE>
M: output-port stream-write M: output-port stream-write
dup check-disposed dup check-disposed [
[ binary-object integer>fixnum-strict ] [ port-write ] bi* ; binary-object
[ check-c-ptr ] [ integer>fixnum-strict ] bi*
] [ port-write ] bi* ;
HOOK: tell-handle os ( handle -- n ) HOOK: tell-handle os ( handle -- n )
@ -235,9 +242,3 @@ M: object underlying-handle underlying-port handle>> ;
HINTS: (decode-until) HINTS: (decode-until)
{ string input-port object } ; { string input-port object } ;
HINTS: M\ input-port stream-read-partial-unsafe
{ fixnum byte-array object } ;
HINTS: M\ input-port stream-read-unsafe
{ fixnum byte-array object } ;