]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/io/buffers/buffers.factor
Slices over specialized arrays can now be passed to C functions, written to binary...
[factor.git] / basis / io / buffers / buffers.factor
old mode 100755 (executable)
new mode 100644 (file)
index e6a0070..562abad
@@ -1,14 +1,14 @@
 ! Copyright (C) 2004, 2005 Mackenzie Straight.
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.accessors alien.c-types
-alien.syntax kernel libc math sequences byte-arrays strings
-hints accessors math.order destructors combinators ;
+alien.data alien.syntax kernel libc math sequences byte-arrays
+strings hints math.order destructors combinators ;
 IN: io.buffers
 
 TUPLE: buffer
 { size fixnum }
-{ ptr simple-alien }
+{ ptr alien }
 { fill fixnum }
 { pos fixnum }
 disposed ;
@@ -22,7 +22,7 @@ M: buffer dispose* ptr>> free ;
     swap >>fill 0 >>pos drop ;
 
 : buffer-capacity ( buffer -- n )
-    [ size>> ] [ fill>> ] bi - ; inline
+    [ size>> ] [ fill>> ] bi - >fixnum ; inline
 
 : buffer-empty? ( buffer -- ? )
     fill>> zero? ; inline
@@ -36,15 +36,13 @@ M: buffer dispose* ptr>> free ;
     [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
 
 : buffer-pop ( buffer -- byte )
-    [ buffer-peek ] [ 1 swap buffer-consume ] bi ;
-
-HINTS: buffer-pop buffer ;
+    [ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
 
 : buffer-length ( buffer -- n )
     [ fill>> ] [ pos>> ] bi - ; inline
 
 : buffer@ ( buffer -- alien )
-    [ pos>> ] [ ptr>> ] bi <displaced-alien> ;
+    [ pos>> ] [ ptr>> ] bi <displaced-alien> ; inline
 
 : buffer-read ( n buffer -- byte-array )
     [ buffer-length min ] keep
@@ -62,21 +60,22 @@ HINTS: buffer-read fixnum buffer ;
 HINTS: n>buffer fixnum buffer ;
 
 : >buffer ( byte-array buffer -- )
-    [ buffer-end byte-array>memory ]
-    [ [ length ] dip n>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 ]
     [ 1 swap n>buffer ]
-    bi ;
-
-HINTS: byte>buffer fixnum buffer ;
+    bi ; inline
 
 : search-buffer-until ( pos fill ptr separators -- n )
-    [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ;
+    [ iota ] 2dip
+    [ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry
+    find-from drop ; inline
 
 : finish-buffer-until ( buffer n -- byte-array separator )
     [
@@ -86,7 +85,7 @@ HINTS: byte>buffer fixnum buffer ;
     ] [
         [ buffer-length ] keep
         buffer-read f
-    ] if* ;
+    ] if* ; inline
 
 : buffer-until ( separators buffer -- byte-array separator )
     swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip