diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor index 0bcb7b9401..9592fb1812 100644 --- a/basis/alien/c-types/c-types-docs.factor +++ b/basis/alien/c-types/c-types-docs.factor @@ -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." } diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index ef47f4b69c..17bf4765b8 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -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 diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor index 93b1afd436..462bed8b76 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -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 diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 4fafc528fd..798bfb8ae9 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -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 diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 204b05517b..a3b198bd94 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -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 hashcode* ; inline + binary-object 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-slots ] bi + [ ] [ struct-slots ] bi [ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ; M: struct-class initial-value* ; 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> ; - + : parse-struct-slots ( slots -- slots' more? ) scan { { ";" [ f ] } diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index 23358d9a0e..ce5ad2c9a0 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -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 index 0000000000..e637999880 --- /dev/null +++ b/basis/io/ports/ports-tests.factor @@ -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 diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 727d69adf8..0927e7e480 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -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 ] dip + [ buffer>> size>> ] [ '[ _ stream-write ] ] bi + each ; + M: output-port stream-write dup check-disposed - over length over buffer>> size>> > [ - [ buffer>> size>> ] - [ [ 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 ; diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index e508b49a19..15db425137 100644 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -117,8 +117,7 @@ M: byte-array bit-count byte-array-bit-count ; M: object bit-count - [ >c-ptr ] [ byte-length ] bi - byte-array-bit-count ; + binary-object byte-array-bit-count ; : even-parity? ( obj -- ? ) bit-count even? ; diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor index 6148962ee0..9d60dd03d4 100644 --- a/basis/math/vectors/conversion/conversion.factor +++ b/basis/math/vectors/conversion/conversion.factor @@ -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 ; diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index a60026317d..8d804247d3 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -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 ] diff --git a/basis/nibble-arrays/nibble-arrays.factor b/basis/nibble-arrays/nibble-arrays.factor index 16bea56862..865491ed21 100644 --- a/basis/nibble-arrays/nibble-arrays.factor +++ b/basis/nibble-arrays/nibble-arrays.factor @@ -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 diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 2aca62cc77..f7070c68e1 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -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>> "" 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: diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index 557ca25cd5..c16fe2510d 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -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 diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 4bf7dfe0fd..e93dca9072 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -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 diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 9389b24227..60c1cdaf69 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -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." } ; diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 16c33fc1c3..42f48f97aa 100644 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -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 diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 367dc4d942..43aeb6bd70 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -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 )) } { "" "kernel" "primitive_wrapper" (( obj -- wrapper )) } { "callstack" "kernel" "primitive_callstack" (( -- cs )) } diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index da5d670659..cf58dbfe05 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -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 diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index aa6e087442..11848cfa03 100644 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -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 diff --git a/core/io/io.factor b/core/io/io.factor index 48d7f413b8..519d6535b9 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -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 -- ) diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor index 96b122549d..dc95d454fa 100644 --- a/core/io/streams/byte-array/byte-array-tests.factor +++ b/core/io/streams/byte-array/byte-array-tests.factor @@ -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 diff --git a/core/io/streams/c/c-docs.factor b/core/io/streams/c/c-docs.factor index 7103e49f4a..246f65de98 100644 --- a/core/io/streams/c/c-docs.factor +++ b/core/io/streams/c/c-docs.factor @@ -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 } " or " { $link } " 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." } ; diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 657c6ccd75..d05daf3662 100644 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -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 [ + int-array{ 1 2 3 } write + ] with-output-stream +] unit-test + +[ int-array{ 1 2 3 } ] [ + "test.txt" temp-file "rb" fopen [ + 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 [ + "OMGFAIL" write + ] with-output-stream +] must-fail diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index d26f03aa5e..9ebf7f7018 100644 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -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 ; diff --git a/extra/audio/vorbis/vorbis.factor b/extra/audio/vorbis/vorbis.factor index 78f637770f..e67c7b7934 100644 --- a/extra/audio/vorbis/vorbis.factor +++ b/extra/audio/vorbis/vorbis.factor @@ -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 diff --git a/extra/mongodb/operations/operations.factor b/extra/mongodb/operations/operations.factor index 8ecd5df54c..56e560f07a 100644 --- a/extra/mongodb/operations/operations.factor +++ b/extra/mongodb/operations/operations.factor @@ -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 short ; +FROM: alien.c-types => short uchar ; SPECIALIZED-ARRAY: uchar SPECIALIZED-ARRAY: short IN: synth.buffers diff --git a/vm/io.cpp b/vm/io.cpp index 8eaaa453b5..0682a1d124 100755 --- 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(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); }