io.ports: implement read-unsafe operations

basis/io/ports/ports.factor

@@ -1,12 +1,13 @@
 ! Copyright (C) 2005, 2010 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel io sequences io.buffers io.timeouts generic
+USING: accessors alien alien.c-types alien.data assocs
-byte-vectors system io.encodings math.order io.backend
+byte-arrays byte-vectors classes combinators continuations
-continuations classes byte-arrays namespaces splitting grouping
+destructors dlists fry generic grouping hints io io.backend
-dlists alien alien.c-types alien.data assocs io.encodings.binary
+io.buffers io.encodings io.encodings.ascii io.encodings.binary
-summary accessors destructors combinators fry specialized-arrays
+io.encodings.private io.encodings.utf8 io.timeouts kernel libc
-locals ;
+locals math math.order namespaces sequences specialized-arrays
-SPECIALIZED-ARRAY: uchar
+specialized-arrays.instances.alien.c-types.uchar splitting
+strings summary system ;
 IN: io.ports
 
 SYMBOL: default-buffer-size
@@ -28,6 +29,7 @@ TUPLE: buffered-port < port { buffer buffer } ;
         default-buffer-size get <buffer> >>buffer ; inline
 
 TUPLE: input-port < buffered-port ;
+INSTANCE: input-port noncopying-reader
 
 M: input-port stream-element-type drop +byte+ ; inline
 
@@ -45,40 +47,44 @@ M: input-port stream-read1
     dup check-disposed
     dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
 
-: read-step ( count port -- byte-array/f )
+: read-step ( count port -- count/f ptr/f )
     {
-        { [ over 0 = ] [ 2drop f ] }
+        { [ over 0 = ] [ 2drop f f ] }
-        { [ dup wait-to-read ] [ 2drop f ] }
+        { [ dup wait-to-read ] [ 2drop f f ] }
-        [ buffer>> buffer-read ]
+        [ buffer>> buffer-read-unsafe ]
     } cond ;
 
 : prepare-read ( count stream -- count stream )
     dup check-disposed [ 0 max >fixnum ] dip ; inline
 
-M: input-port stream-read-partial ( max stream -- byte-array/f )
+M: input-port stream-read-partial-unsafe ( n dst port -- count )
-    prepare-read read-step ;
+    [ swap ] dip prepare-read read-step
+    [ swap [ memcpy ] keep ] [ 2drop 0 ] if* ;
 
-: read-loop ( count port accum -- )
+:: read-loop ( n-remaining n-read port dst -- n-total )
-    pick over length - dup 0 > [
+    n-remaining 0 > [
-        pick read-step dup [
+        n-remaining port read-step :> ( n-buffered ptr )
-            append! read-loop
+        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 )
+    ptr [
+        dst ptr n-buffered memcpy
+        n-buffered n' < [
+            n-buffered dst <displaced-alien> :> dst'
+            n' n-buffered - n-buffered port dst' read-loop
         ] [
-            2drop 2drop
+            n-buffered
         ] if
-    ] [
+    ] [ 0 ] if ;
-        2drop 2drop
-    ] if ;
-
-M: input-port stream-read
-    prepare-read
-    2dup read-step dup [
-        pick over length > [
-            pick <byte-vector>
-            [ push-all ] keep
-            [ read-loop ] keep
-            B{ } like
-        ] [ 2nip ] if
-    ] [ 2nip ] if ;
 
 : read-until-step ( separators port -- string/f separator/f )
     dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
@@ -211,8 +217,6 @@ GENERIC: underlying-handle ( stream -- handle )
 M: object underlying-handle underlying-port handle>> ;
 
 ! Fast-path optimization
-USING: hints strings io.encodings.utf8 io.encodings.ascii
-io.encodings.private ;
 
 HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;