]> gitweb.factorcode.org Git - factor.git/commitdiff
Specialized arrays, structs and other objects responding to the >c-ptr / byte-length...
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 24 Feb 2010 07:18:41 +0000 (20:18 +1300)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 24 Feb 2010 07:18:41 +0000 (20:18 +1300)
29 files changed:
basis/alien/c-types/c-types-docs.factor
basis/alien/c-types/c-types.factor
basis/alien/data/data.factor
basis/bit-arrays/bit-arrays.factor
basis/classes/struct/struct.factor
basis/io/buffers/buffers.factor
basis/io/ports/ports-tests.factor [new file with mode: 0644]
basis/io/ports/ports.factor
basis/math/bitwise/bitwise.factor
basis/math/vectors/conversion/conversion.factor
basis/math/vectors/simd/simd.factor
basis/nibble-arrays/nibble-arrays.factor
basis/specialized-arrays/specialized-arrays.factor
basis/specialized-vectors/specialized-vectors.factor
basis/stack-checker/known-words/known-words.factor
core/alien/alien-docs.factor
core/alien/alien.factor
core/bootstrap/primitives.factor
core/io/files/files-tests.factor
core/io/io-docs.factor
core/io/io.factor
core/io/streams/byte-array/byte-array-tests.factor
core/io/streams/c/c-docs.factor
core/io/streams/c/c-tests.factor
core/io/streams/c/c.factor
extra/audio/vorbis/vorbis.factor
extra/mongodb/operations/operations.factor
extra/synth/buffers/buffers.factor
vm/io.cpp

index 0bcb7b9401817157f495f6b0cdd750ba64847ca5..9592fb1812715d38f11e4ae412d8df18f7e93d4c 100644 (file)
@@ -6,10 +6,6 @@ QUALIFIED: math
 QUALIFIED: sequences
 IN: alien.c-types
 
-HELP: byte-length
-{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
-{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ;
-
 HELP: heap-size
 { $values { "name" "a C type name" } { "size" math:integer } }
 { $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
index ef47f4b69ce92ef3cbf6239d2237fbddfc8cf578..17bf4765b8f4c0c3a33803ca49172d14b6c11f4d 100644 (file)
@@ -193,12 +193,6 @@ M: c-type-name stack-size c-type stack-size ;
 
 M: c-type stack-size size>> cell align ;
 
-GENERIC: byte-length ( seq -- n ) flushable
-
-M: byte-array byte-length length ; inline
-
-M: f byte-length drop 0 ; inline
-
 : >c-bool ( ? -- int ) 1 0 ? ; inline
 
 : c-bool> ( int -- ? ) 0 = not ; inline
index 93b1afd436cfd878129d4339c920f914d27830a2..462bed8b76fd6fc4b723a0f73ff9e2ff39fbb870 100644 (file)
@@ -1,7 +1,8 @@
-! (c)2009 Slava Pestov, Joe Groff bsd license
+! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
 USING: accessors alien alien.c-types alien.strings arrays
 byte-arrays cpu.architecture fry io io.encodings.binary
-io.files io.streams.memory kernel libc math sequences words ;
+io.files io.streams.memory kernel libc math sequences words
+byte-vectors ;
 IN: alien.data
 
 GENERIC: require-c-array ( c-type -- )
@@ -65,6 +66,12 @@ M: memory-stream stream-read
 : byte-array>memory ( byte-array base -- )
     swap dup byte-length memcpy ; inline
 
+M: byte-vector stream-write
+    [ binary-object ] dip
+    [ [ length + ] keep lengthen drop ]
+    [ '[ _ underlying>> ] 2dip memcpy ]
+    3bi ;
+
 M: value-type c-type-rep drop int-rep ;
 
 M: value-type c-type-getter
index 4fafc528fdcb7728633915184f4ec5e97f23cdb8..798bfb8ae94cd5c2cd151b34b4799f018177d2e2 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.data accessors math alien.accessors kernel
+USING: alien alien.data accessors math alien.accessors kernel
 kernel.private sequences sequences.private byte-arrays
 parser prettyprint.custom fry ;
 IN: bit-arrays
index 204b05517b0a91f9dea23def14eae5274acf8e8c..a3b198bd943f46fa91c50fb4800df69b0ca60a58 100644 (file)
@@ -46,11 +46,11 @@ M: struct >c-ptr
 M: struct equal?
     {
         [ [ class ] bi@ = ]
-        [ [ >c-ptr ] [ [ >c-ptr ] [ byte-length ] bi ] bi* memory= ]
+        [ [ >c-ptr ] [ binary-object ] bi* memory= ]
     } 2&& ; inline
 
 M: struct hashcode*
-    [ >c-ptr ] [ byte-length ] bi <direct-uchar-array> hashcode* ; inline    
+    binary-object <direct-uchar-array> hashcode* ; inline
 
 : struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
 
@@ -137,7 +137,7 @@ PRIVATE>
 
 M: struct-class boa>object
     swap pad-struct-slots
-    [ <struct> ] [ struct-slots ] bi 
+    [ <struct> ] [ struct-slots ] bi
     [ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
 
 M: struct-class initial-value* <struct> ; inline
@@ -203,7 +203,7 @@ M: struct-c-type c-struct? drop t ;
     define-inline-method ;
 
 : clone-underlying ( struct -- byte-array )
-    [ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline
+    binary-object memory>byte-array ; inline
 
 : (define-clone-method) ( class -- )
     [ \ clone ]
@@ -353,7 +353,7 @@ PRIVATE>
 <PRIVATE
 : parse-struct-slot ( -- slot )
     scan scan-c-type \ } parse-until <struct-slot-spec> ;
-    
+
 : parse-struct-slots ( slots -- slots' more? )
     scan {
         { ";" [ f ] }
index 23358d9a0e20c2fcfd61e331ba344da53ccc1434..ce5ad2c9a075401c22789c1347fb62c6ced72653 100644 (file)
@@ -61,7 +61,7 @@ HINTS: n>buffer fixnum buffer ;
 
 : >buffer ( byte-array buffer -- )
     [ buffer-end byte-array>memory ]
-    [ [ length ] dip n>buffer ]
+    [ [ byte-length ] dip n>buffer ]
     2bi ;
 
 HINTS: >buffer byte-array buffer ;
diff --git a/basis/io/ports/ports-tests.factor b/basis/io/ports/ports-tests.factor
new file mode 100644 (file)
index 0000000..e637999
--- /dev/null
@@ -0,0 +1,23 @@
+USING: destructors io io.encodings.binary io.files io.directories
+io.files.temp io.ports kernel sequences math
+specialized-arrays.instances.alien.c-types.int tools.test ;
+IN: io.ports.tests
+
+! Make sure that writing malloced storage to a file works, and
+! also make sure that writes larger than the buffer size work
+
+[ ] [
+    "test.txt" temp-file binary [
+        100,000 iota
+        0
+        100,000 malloc-int-array &dispose [ copy ] keep write
+    ] with-file-writer
+] unit-test
+
+[ t ] [
+    "test.txt" temp-file binary [
+        100,000 4 * read byte-array>int-array 100,000 iota sequence=
+    ] with-file-reader
+] unit-test
+
+[ ] [ "test.txt" temp-file delete-file ] unit-test
index 727d69adf8d2382415a1c18ff6962c6040c1159f..0927e7e480b0991829b16447a9b4d8abff0932b0 100644 (file)
@@ -1,10 +1,11 @@
-! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman
+! 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
 byte-vectors system io.encodings math.order io.backend
-continuations classes byte-arrays namespaces splitting
-grouping dlists assocs io.encodings.binary summary accessors
-destructors combinators ;
+continuations classes byte-arrays namespaces splitting grouping
+dlists alien alien.c-types assocs io.encodings.binary summary
+accessors destructors combinators fry specialized-arrays ;
+SPECIALIZED-ARRAY: uchar
 IN: io.ports
 
 SYMBOL: default-buffer-size
@@ -111,14 +112,17 @@ M: output-port stream-write1
     1 over wait-to-write
     buffer>> byte>buffer ; inline
 
+: write-in-groups ( byte-array port -- )
+    [ binary-object <direct-uchar-array> ] dip
+    [ buffer>> size>> <groups> ] [ '[ _ stream-write ] ] bi
+    each ;
+
 M: output-port stream-write
     dup check-disposed
-    over length over buffer>> size>> > [
-        [ buffer>> size>> <groups> ]
-        [ [ stream-write ] curry ] bi
-        each
+    2dup [ byte-length ] [ buffer>> size>> ] bi* > [
+        write-in-groups
     ] [
-        [ [ length ] dip wait-to-write ]
+        [ [ byte-length ] dip wait-to-write ]
         [ buffer>> >buffer ] 2bi
     ] if ;
 
index e508b49a199d0d0054a9126e4a38f9415b500a50..15db425137a7bedfa2d0949555ec53d60f1c91ed 100644 (file)
@@ -117,8 +117,7 @@ M: byte-array bit-count
     byte-array-bit-count ;
 
 M: object bit-count
-    [ >c-ptr ] [ byte-length ] bi <direct-uchar-array>
-    byte-array-bit-count ;
+    binary-object <direct-uchar-array> byte-array-bit-count ;
 
 : even-parity? ( obj -- ? ) bit-count even? ;
 
index 6148962ee0d5cc6dd5fc8808f1facd888196c4eb..9d60dd03d4e25fb3efdc2545613b258ef2a09c25 100644 (file)
@@ -1,10 +1,10 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien.c-types arrays assocs classes combinators
-combinators.short-circuit fry kernel locals math
-math.vectors math.vectors.simd math.vectors.simd.intrinsics sequences ;
+USING: accessors alien arrays assocs classes combinators
+combinators.short-circuit fry kernel locals math math.vectors
+math.vectors.simd math.vectors.simd.intrinsics sequences ;
 FROM: alien.c-types =>
     char uchar short ushort int uint longlong ulonglong
-    float double ;
+    float double heap-size ;
 IN: math.vectors.conversion
 
 ERROR: bad-vconvert from-type to-type ;
index a60026317d2319744d0de7c57cc7d88eb4ba3541..8d804247d3af681298ff2acea8227e91c816f12c 100644 (file)
@@ -1,9 +1,9 @@
-USING: accessors alien.c-types arrays byte-arrays classes combinators
+USING: accessors alien arrays byte-arrays classes combinators
 cpu.architecture effects fry functors generalizations generic
 generic.parser kernel lexer literals macros math math.functions
-math.vectors math.vectors.private math.vectors.simd.intrinsics namespaces parser
-prettyprint.custom quotations sequences sequences.private vocabs
-vocabs.loader words ;
+math.vectors math.vectors.private math.vectors.simd.intrinsics
+namespaces parser prettyprint.custom quotations sequences
+sequences.private vocabs vocabs.loader words ;
 QUALIFIED-WITH: alien.c-types c
 IN: math.vectors.simd
 
@@ -107,7 +107,7 @@ PRIVATE>
 
 M: simd-128 hashcode* underlying>> hashcode* ; inline
 M: simd-128 clone [ clone ] change-underlying ; inline
-M: simd-128 c:byte-length drop 16 ; inline
+M: simd-128 byte-length drop 16 ; inline
 
 M: simd-128 new-sequence
     2dup length =
@@ -243,7 +243,7 @@ A{     DEFINES       ${T}{
 
 ELT     [ A-rep rep-component-type ]
 N       [ A-rep rep-length ]
-COERCER [ ELT c-type-class "coercer" word-prop [ ] or ]
+COERCER [ ELT c:c-type-class "coercer" word-prop [ ] or ]
 
 SET-NTH [ ELT dup c:c-setter c:array-accessor ]
 
index 16bea56862fe19bd921ae11d591cd89473043f7d..865491ed21345c9e471f96e06c123704bb7f1b32 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel sequences sequences.private byte-arrays
-alien.c-types prettyprint.custom parser accessors ;
+alien prettyprint.custom parser accessors ;
 IN: nibble-arrays
 
 TUPLE: nibble-array
index 2aca62cc771c3a3b35cdfb4e6bf944ce2b921422..f7070c68e1e794eec963d4d419632cd7e659e1e7 100644 (file)
@@ -117,6 +117,7 @@ M: A v*high [ * \ T heap-size neg shift ] 2map ; inline
 ;FUNCTOR
 
 GENERIC: underlying-type ( c-type -- c-type' )
+
 M: c-type-word underlying-type
     dup "c-type" word-prop {
         { [ dup not ] [ drop no-c-type ] }
@@ -149,18 +150,21 @@ M: c-type-word c-array-constructor
     underlying-type
     dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
 M: pointer c-array-constructor drop void* c-array-constructor ;
 
 M: c-type-word c-(array)-constructor
     underlying-type
     dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
 M: pointer c-(array)-constructor drop void* c-(array)-constructor ;
 
 M: c-type-word c-direct-array-constructor
     underlying-type
     dup [ name>> "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
 M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ;
 
 SYNTAX: SPECIALIZED-ARRAYS:
index 557ca25cd5929b4a3562cce4d1ba2f5ab6cc90e8..c16fe2510d7d017fa9a47b3314366e0841b3d498 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.parser assocs
-compiler.units functors growable kernel lexer math namespaces parser
-prettyprint.custom sequences specialized-arrays
+USING: accessors alien alien.c-types alien.parser assocs
+compiler.units functors growable kernel lexer math namespaces
+parser prettyprint.custom sequences specialized-arrays
 specialized-arrays.private strings vocabs vocabs.parser
 vocabs.generated fry make ;
 QUALIFIED: vectors.functor
index 4bf7dfe0fd98570a2946b7c2117df2d8c8858aac..e93dca90725ba3169c5d33afa535ae71bca8b8ed 100644 (file)
@@ -652,15 +652,15 @@ M: bad-executable summary
 
 \ fgetc { alien } { object } define-primitive
 
-\ fwrite { string alien } { } define-primitive
+\ fwrite { c-ptr integer alien } { } define-primitive
 
 \ fputc { object alien } { } define-primitive
 
-\ fread { integer string } { object } define-primitive
+\ fread { integer alien } { object } define-primitive
 
 \ fflush { alien } { } define-primitive
 
-\ fseek { alien integer integer } { } define-primitive
+\ fseek { integer integer alien } { } define-primitive
 
 \ ftell { alien } { integer } define-primitive
 
index 9389b242279d195ff14dafb858431b957ba0c5c1..60c1cdaf69dc3a623e79f2bf79c7dc5688e260f0 100644 (file)
@@ -1,9 +1,19 @@
 USING: byte-arrays arrays help.syntax help.markup
 alien.syntax compiler definitions math libc eval
 debugger parser io io.backend system alien.accessors
-alien.libraries alien.c-types quotations ;
+alien.libraries alien.c-types quotations kernel ;
 IN: alien
 
+HELP: >c-ptr
+{ $values { "object" object } { "c-ptr" c-ptr } }
+{ $contract "Outputs a pointer to the binary data of this object." } ;
+
+HELP: byte-length
+{ $values { "object" object } { "n" "a non-negative integer" } }
+{ $contract "Outputs the number of bytes of binary data that will be output by " { $link >c-ptr } "." } ;
+
+{ >c-ptr byte-length } related-words
+
 HELP: alien
 { $class-description "The class of alien pointers. See " { $link "syntax-aliens" } " for syntax and " { $link "c-data" } " for general information." } ;
 
index 16c33fc1c33ea773b3e2c4194fd81c52299148ec..42f48f97aad2e6abce6a12165839dab549a0a569 100644 (file)
@@ -8,10 +8,19 @@ PREDICATE: pinned-alien < alien underlying>> not ;
 
 UNION: pinned-c-ptr pinned-alien POSTPONE: f ;
 
-GENERIC: >c-ptr ( obj -- c-ptr )
+GENERIC: >c-ptr ( obj -- c-ptr ) flushable
 
 M: c-ptr >c-ptr ; inline
 
+GENERIC: byte-length ( seq -- n ) flushable
+
+M: byte-array byte-length length ; inline
+
+M: f byte-length drop 0 ; inline
+
+: binary-object ( obj -- c-ptr n )
+    [ >c-ptr ] [ byte-length ] bi ; inline
+
 SLOT: underlying
 
 M: object >c-ptr underlying>> ; inline
index 367dc4d942331aaaf26604b53c61b7f0a6018f0c..43aeb6bd700421a27fa70308c2aa942676279344 100644 (file)
@@ -434,7 +434,7 @@ tuple
     { "fread" "io.streams.c" "primitive_fread" (( n alien -- str/f )) }
     { "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) }
     { "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) }
-    { "fwrite" "io.streams.c" "primitive_fwrite" (( string alien -- )) }
+    { "fwrite" "io.streams.c" "primitive_fwrite" (( data length alien -- )) }
     { "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) }
     { "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
     { "callstack" "kernel" "primitive_callstack" (( -- cs )) }
index da5d67065908a075f2fc24ea52530d8959b05866..cf58dbfe05585a5823cf367c90af71840974c7a3 100644 (file)
@@ -2,7 +2,8 @@ USING: arrays debugger.threads destructors io io.directories
 io.encodings.ascii io.encodings.binary io.encodings.string
 io.encodings.8-bit.latin1 io.files io.files.private
 io.files.temp io.files.unique kernel make math sequences system
-threads tools.test generic.single ;
+threads tools.test generic.single specialized-arrays alien.c-types ;
+SPECIALIZED-ARRAY: int
 IN: io.files.tests
 
 [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
@@ -65,6 +66,27 @@ IN: io.files.tests
     ] with-file-reader
 ] unit-test
 
+! Writing specialized arrays to binary streams should work
+[ ] [
+    "test.txt" temp-file binary [
+        int-array{ 1 2 3 } write
+    ] with-file-writer
+] unit-test
+
+[ int-array{ 1 2 3 } ] [
+    "test.txt" temp-file binary [
+        3 4 * read
+    ] with-file-reader
+    byte-array>int-array
+] unit-test
+
+! Writing strings to binary streams should fail
+[
+    "test.txt" temp-file binary [
+        "OMGFAIL" write
+    ] with-file-writer
+] must-fail
+
 ! Test EOF behavior
 [ 10 ] [
     image binary [
@@ -73,8 +95,7 @@ IN: io.files.tests
     ] with-file-reader
 ] unit-test
 
-USE: debugger.threads
-
+! Make sure that writing to a closed stream from another thread doesn't crash
 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 
 [ ] [ "test-quux.txt" temp-file delete-file ] unit-test
index aa6e087442c263fa6abd97e9fedc74e649cd7173..11848cfa0369fbd1792dae53b661ee9a70c68701 100644 (file)
@@ -1,7 +1,21 @@
 USING: help.markup help.syntax quotations hashtables kernel
-classes strings continuations destructors math byte-arrays ;
+classes strings continuations destructors math byte-arrays
+alien ;
 IN: io
 
+ARTICLE: "stream-types" "Binary and text streams"
+"A word which outputs the stream element type:"
+{ $subsections stream-element-type }
+"Stream element types:"
+{ $subsections +byte+ +character+ }
+"The stream element type is the data type read and written by " { $link stream-read1 } " and " { $link stream-write1 } "."
+$nl
+"Binary streams have an element type of " { $link +byte+ } ". Elements are integers in the range " { $snippet "[0,255]" } ", representing bytes. Reading a sequence of elements produces a " { $link byte-array } ". Any object implementing the " { $link >c-ptr } " and " { $link byte-length } " generic words can be written to a binary stream."
+$nl
+"Character streams have an element tye of " { $link +character+ } ". Elements are non-negative integers, representing Unicode code points. Only instances of the " { $link string } " class can be read or written on a character stream."
+$nl
+"Most external streams are binary streams, and can be wrapped in string streams once a suitable encoding has been provided; see " { $link "io.encodings" } "." ;
+
 HELP: +byte+
 { $description "A stream element type. See " { $link stream-element-type } " for explanation." } ;
 
@@ -10,15 +24,7 @@ HELP: +character+
 
 HELP: stream-element-type
 { $values { "stream" "a stream" } { "type" { $link +byte+ } " or " { $link +character+ } } }
-{ $description
-  "Outputs one of the following two values:"
-  { $list
-    { { $link +byte+ } " - indicates that stream elements are integers in the range " { $snippet "[0,255]" } "; they represent bytes. Reading a sequence of elements produces a " { $link byte-array } "." }
-    { { $link +character+ } " - indicates that stream elements are non-negative integers, representing Unicode code points. Reading a sequence of elements produces a " { $link string } "." }
-  }
-  "Most external streams are binary streams, and can be wrapped in string streams once a suitable encoding has been provided; see " { $link "io.encodings" } "."
-  
-} ;
+{ $contract "Outputs one of " { $link +byte+ } " or " { $link +character+ } "." } ;
 
 HELP: stream-readln
 { $values { "stream" "an input stream" } { "str/f" "a string or " { $link f } } }
@@ -57,8 +63,8 @@ HELP: stream-write1
 $io-error ;
 
 HELP: stream-write
-{ $values { "seq" "a byte array or string" } { "stream" "an output stream" } }
-{ $contract "Writes a sequence of elements to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
+{ $values { "data" "binary data or a string" } { "stream" "an output stream" } }
+{ $contract "Writes a piece of data to the stream. If the stream performs buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." }
 { $notes "Most code only works on one stream at a time and should instead use " { $link write } "; see " { $link "stdio" } "." }
 $io-error ;
 
@@ -262,9 +268,7 @@ $nl
 "Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written to use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "."
 $nl
 "All streams must implement the " { $link dispose } " word in addition to the stream protocol."
-$nl
-"The following word is required for all input and output streams:"
-{ $subsections stream-element-type }
+{ $subsections "stream-types" }
 "These words are required for binary and string input streams:"
 { $subsections
     stream-read1
index 48d7f413b8723bb86a14b41ae7f2f4e36f86bb55..519d6535b9765aa47873b88f672a1218a4612cd9 100644 (file)
@@ -15,7 +15,7 @@ GENERIC: stream-read-partial ( n stream -- seq )
 GENERIC: stream-readln ( stream -- str/f )
 
 GENERIC: stream-write1 ( elt stream -- )
-GENERIC: stream-write ( seq stream -- )
+GENERIC: stream-write ( data stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
index 96b122549d840ce9a8f926742f4a589a581a26a0..dc95d454fa137c5196b3cbbb47831461a1da54a7 100644 (file)
@@ -1,5 +1,8 @@
 USING: tools.test io.streams.byte-array io.encodings.binary
-io.encodings.utf8 io kernel arrays strings namespaces math ;
+io.encodings.utf8 io kernel arrays strings namespaces math
+specialized-arrays alien.c-types ;
+SPECIALIZED-ARRAY: int
+IN: io.streams.byte-array.tests
 
 [ B{ } ] [ B{ } binary [ contents ] with-byte-reader ] unit-test
 [ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
@@ -37,3 +40,9 @@ io.encodings.utf8 io kernel arrays strings namespaces math ;
 [ B{ 123 } ] [
     binary [ 123 >bignum write1 ] with-byte-writer
 ] unit-test
+
+! Writing specialized arrays to byte writers
+[ int-array{ 1 2 3 } ] [
+    binary [ int-array{ 1 2 3 } write ] with-byte-writer
+    byte-array>int-array
+] unit-test
index 7103e49f4ab71208a9f17d2a80984b0d039421b1..246f65de9877bfac9e211096b17a082e6bbfcb38 100644 (file)
@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io io.files threads
-strings byte-arrays io.streams.plain ;
+strings byte-arrays io.streams.plain alien math ;
 IN: io.streams.c
 
 ARTICLE: "io.streams.c" "ANSI C streams"
@@ -42,9 +42,9 @@ HELP: fopen
 { $errors "Throws an error if the file could not be opened." }
 { $notes "User code should call " { $link <file-reader> } " or " { $link <file-writer> } " to get a high level stream." } ;
 
-HELP: fwrite ( string alien -- )
-{ $values { "string" "a string" } { "alien" "a C FILE* handle" } }
-{ $description "Writes a string of text to a C FILE* handle." }
+HELP: fwrite
+{ $values { "data" c-ptr } { "length" integer } { "alien" "a C FILE* handle" } }
+{ $description "Writes some bytes to a C FILE* handle." }
 { $errors "Throws an error if the output operation failed." } ;
 
 HELP: fflush ( alien -- )
@@ -62,7 +62,7 @@ HELP: fgetc ( alien -- ch/f )
 { $errors "Throws an error if the input operation failed." } ;
 
 HELP: fread ( n alien -- str/f )
-{ $values { "n" "a positive integer" } { "alien" "a C FILE* handle" } { "str/f" "a string or " { $link f } } }
+{ $values { "n" "a positive integer" } { "alien" "a C FILE* handle" } { "str/f" { $maybe string } } }
 { $description "Reads a sequence of characters from a C FILE* handle, and outputs " { $link f } " on end of file." }
 { $errors "Throws an error if the input operation failed." } ;
 
index 657c6ccd75ad2404452e5b7ace4d12461abecf79..d05daf3662bdd0e7f79aabccf10ff0a645d87276 100644 (file)
@@ -1,5 +1,7 @@
 USING: tools.test io.files io.files.temp io io.streams.c
-io.encodings.ascii strings destructors kernel ;
+io.encodings.ascii strings destructors kernel specialized-arrays
+alien.c-types math ;
+SPECIALIZED-ARRAY: int
 IN: io.streams.c.tests
 
 [ "hello world" ] [
@@ -17,3 +19,24 @@ IN: io.streams.c.tests
     3 over stream-read drop
     [ stream-tell ] [ dispose ] bi
 ] unit-test
+
+! Writing specialized arrays to binary streams
+[ ] [
+    "test.txt" temp-file "wb" fopen <c-writer> [
+        int-array{ 1 2 3 } write
+    ] with-output-stream
+] unit-test
+
+[ int-array{ 1 2 3 } ] [
+    "test.txt" temp-file "rb" fopen <c-reader> [
+        3 4 * read
+    ] with-input-stream
+    byte-array>int-array
+] unit-test
+
+! Writing strings to binary streams should fail
+[
+    "test.txt" temp-file "wb" fopen <c-writer> [
+        "OMGFAIL" write
+    ] with-output-stream
+] must-fail
index d26f03aa5ee80e9279cf5a6e8334585572dd95ae..9ebf7f701836ea99c4140f31306ad4db8c4d7ed1 100644 (file)
@@ -1,9 +1,9 @@
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private namespaces make io io.encodings sequences
-math generic threads.private classes io.backend io.files
-io.encodings.utf8 alien.strings continuations destructors byte-arrays
-accessors combinators ;
+USING: alien alien.strings kernel kernel.private namespaces make
+io io.encodings sequences math generic threads.private classes
+io.backend io.files io.encodings.utf8 continuations destructors
+byte-arrays accessors combinators ;
 IN: io.streams.c
 
 TUPLE: c-stream < disposable handle ;
@@ -16,12 +16,14 @@ M: c-stream dispose* handle>> fclose ;
 M: c-stream stream-tell handle>> ftell ;
 
 M: c-stream stream-seek
-    handle>> swap {
-        { seek-absolute [ 0 ] }
-        { seek-relative [ 1 ] }
-        { seek-end [ 2 ] }
-        [ bad-seek-type ]
-    } case fseek ;
+    [
+        {
+            { seek-absolute [ 0 ] }
+            { seek-relative [ 1 ] }
+            { seek-end [ 2 ] }
+            [ bad-seek-type ]
+        } case
+    ] [ handle>> ] bi* fseek ;
 
 TUPLE: c-writer < c-stream ;
 
@@ -31,7 +33,9 @@ M: c-writer stream-element-type drop +byte+ ;
 
 M: c-writer stream-write1 dup check-disposed handle>> fputc ;
 
-M: c-writer stream-write dup check-disposed handle>> fwrite ;
+M: c-writer stream-write
+    dup check-disposed
+    [ [ >c-ptr ] [ byte-length ] bi ] [ handle>> ] bi* fwrite ;
 
 M: c-writer stream-flush dup check-disposed handle>> fflush ;
 
@@ -93,6 +97,6 @@ M: c-io-backend (file-appender)
     #! print stuff from contexts where the I/O system would
     #! otherwise not work (tools.deploy.shaker, the I/O
     #! multiplexer thread).
-    "\n" append >byte-array
+    "\n" append >byte-array dup length
     stdout-handle fwrite
     stdout-handle fflush ;
index 78f637770fd67d41e6a75572b6755bbb11599bbf..e67c7b7934ebf3a72a05a93d3810301f08af732b 100644 (file)
@@ -1,8 +1,9 @@
 ! (c)2007, 2010 Chris Double, Joe Groff bsd license
-USING: accessors alien.c-types audio.engine byte-arrays classes.struct
-combinators destructors fry io io.files io.encodings.binary
-kernel libc locals make math math.order math.parser ogg ogg.vorbis
-sequences specialized-arrays specialized-vectors ;
+USING: accessors alien alien.c-types audio.engine byte-arrays
+classes.struct combinators destructors fry io io.files
+io.encodings.binary kernel libc locals make math math.order
+math.parser ogg ogg.vorbis sequences specialized-arrays
+specialized-vectors ;
 FROM: alien.c-types => float short void* ;
 SPECIALIZED-ARRAYS: float void* ;
 SPECIALIZED-VECTOR: short
index 8ecd5df54c8de8a74b488c52f453cc6a61c8b841..56e560f07ad924faa86240a29b8f549b0b0304e3 100644 (file)
@@ -1,12 +1,9 @@
 USING: accessors assocs bson.reader bson.writer byte-arrays
-byte-vectors combinators formatting fry io io.binary io.encodings.private
-io.encodings.binary io.encodings.string io.encodings.utf8 io.encodings.utf8.private io.files
-kernel locals math mongodb.msg namespaces sequences uuid bson.writer.private ;
-
-IN: alien.c-types
-
-M: byte-vector byte-length length ;
-
+byte-vectors combinators formatting fry io io.binary
+io.encodings.private io.encodings.binary io.encodings.string
+io.encodings.utf8 io.encodings.utf8.private io.files kernel
+locals math mongodb.msg namespaces sequences uuid
+bson.writer.private ;
 IN: mongodb.operations
 
 <PRIVATE
index 978fb32d423492a5c7afd22192f3b616648415ad..e71b136940892e36919b8fc4870a339a4a584ee1 100644 (file)
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types combinators kernel locals math
+USING: accessors alien combinators kernel locals math
 math.ranges openal sequences sequences.merged specialized-arrays ;
-FROM: alien.c-types => short ;
+FROM: alien.c-types => short uchar ;
 SPECIALIZED-ARRAY: uchar
 SPECIALIZED-ARRAY: short
 IN: synth.buffers
index 8eaaa453b5015be9898222177c3d354621ae1366..0682a1d124e552430f9fc4901906535ca592dd67 100755 (executable)
--- a/vm/io.cpp
+++ b/vm/io.cpp
@@ -218,14 +218,13 @@ void factor_vm::primitive_fputc()
 void factor_vm::primitive_fwrite()
 {
        FILE *file = pop_file_handle();
-       byte_array *text = untag_check<byte_array>(ctx->pop());
-       cell length = array_capacity(text);
-       char *string = (char *)(text + 1);
+       cell length = to_cell(ctx->pop());
+       char *text = alien_offset(ctx->pop());
 
        if(length == 0)
                return;
 
-       size_t written = safe_fwrite(string,1,length,file);
+       size_t written = safe_fwrite(text,1,length,file);
        if(written != length)
                io_error();
 }
@@ -238,8 +237,8 @@ void factor_vm::primitive_ftell()
 
 void factor_vm::primitive_fseek()
 {
-       int whence = to_fixnum(ctx->pop());
        FILE *file = pop_file_handle();
+       int whence = to_fixnum(ctx->pop());
        off_t offset = to_signed_8(ctx->pop());
        safe_fseek(file,offset,whence);
 }