Merge branch 'master' of git://factorcode.org/git/factor

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." }

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

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

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

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 <direct-uchar-array> hashcode* ; inline    
+    binary-object <direct-uchar-array> hashcode* ; inline
 
 : struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
 
@@ -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 ]

basis/cocoa/messages/messages.factor

@@ -237,8 +237,8 @@ ERROR: no-objc-type name ;
 
 : import-objc-class ( name quot -- )
     2dup swap define-objc-class-word
-    over objc_getClass [ drop ] [ call( -- ) ] if
+    over class-exists? [ drop ] [ call( -- ) ] if
-    dup objc_getClass [
+    dup class-exists? [
         [ objc_getClass register-objc-methods ]
         [ objc_getMetaClass register-objc-methods ] bi
     ] [ drop ] if ;

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 ;

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

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
+continuations classes byte-arrays namespaces splitting grouping
-grouping dlists assocs io.encodings.binary summary accessors
+dlists alien alien.c-types assocs io.encodings.binary summary
-destructors combinators ;
+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>> > [
+    2dup [ byte-length ] [ buffer>> size>> ] bi* > [
-        [ buffer>> size>> <groups> ]
+        write-in-groups
-        [ [ stream-write ] curry ] bi
-        each
     ] [
-        [ [ length ] dip wait-to-write ]
+        [ [ byte-length ] dip wait-to-write ]
         [ buffer>> >buffer ] 2bi
     ] if ;
 

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 <direct-uchar-array>
+    binary-object <direct-uchar-array> byte-array-bit-count ;
-    byte-array-bit-count ;
 
 : even-parity? ( obj -- ? ) bit-count even? ;
 

basis/math/vectors/conversion/conversion.factor

@@ -1,10 +1,10 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien.c-types arrays assocs classes combinators
+USING: accessors alien arrays assocs classes combinators
-combinators.short-circuit fry kernel locals math
+combinators.short-circuit fry kernel locals math math.vectors
-math.vectors math.vectors.simd math.vectors.simd.intrinsics sequences ;
+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 ;

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
+math.vectors math.vectors.private math.vectors.simd.intrinsics
-prettyprint.custom quotations sequences sequences.private vocabs
+namespaces parser prettyprint.custom quotations sequences
-vocabs.loader words ;
+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 ]
 

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

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>> "<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:

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
+USING: accessors alien alien.c-types alien.parser assocs
-compiler.units functors growable kernel lexer math namespaces parser
+compiler.units functors growable kernel lexer math namespaces
-prettyprint.custom sequences specialized-arrays
+parser prettyprint.custom sequences specialized-arrays
 specialized-arrays.private strings vocabs vocabs.parser
 vocabs.generated fry make ;
 QUALIFIED: vectors.functor

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
 

basis/windows/ddk/winusb/authors.txt

@@ -0,0 +1 @@
+Erik Charlebois

basis/windows/ddk/winusb/platforms.txt

@@ -0,0 +1 @@
+winnt

basis/windows/ddk/winusb/summary.txt

@@ -0,0 +1 @@
+Bindings to the USB section of the Windows DDK.

basis/windows/ddk/winusb/tags.txt

@@ -0,0 +1 @@
+unportable bindings

basis/windows/ddk/winusb/winusb.factor

@@ -0,0 +1,66 @@
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.syntax classes.struct windows.kernel32
+windows.types alien.libraries ;
+IN: windows.ddk.winusb
+
+<< "winusb" "winusb.dll" "stdcall" add-library >>
+LIBRARY: winusb
+
+TYPEDEF: PVOID WINUSB_INTERFACE_HANDLE
+TYPEDEF: WINUSB_INTERFACE_HANDLE* PWINUSB_INTERFACE_HANDLE
+
+STRUCT: USB_INTERFACE_DESCRIPTOR
+    { bLength            UCHAR }
+    { bDescriptorType    UCHAR }
+    { bInterfaceNumber   UCHAR }
+    { bAlternateSetting  UCHAR }
+    { bNumEndpoints      UCHAR }
+    { bInterfaceClass    UCHAR }
+    { bInterfaceSubClass UCHAR }
+    { bInterfaceProtocol UCHAR }
+    { iInterface         UCHAR } ;
+TYPEDEF: USB_INTERFACE_DESCRIPTOR* PUSB_INTERFACE_DESCRIPTOR
+
+C-ENUM:
+    UsbdPipeTypeControl
+    UsbdPipeTypeIsochronous
+    UsbdPipeTypeBulk
+    UsbdPipeTypeInterrupt ;
+TYPEDEF: int USBD_PIPE_TYPE
+
+STRUCT: WINUSB_PIPE_INFORMATION
+    { PipeType                   USBD_PIPE_TYPE }
+    { PipeId                     UCHAR          }
+    { MaximumPacketSize          USHORT         }
+    { Interval                   UCHAR          } ;
+TYPEDEF: WINUSB_PIPE_INFORMATION* PWINUSB_PIPE_INFORMATION
+
+STRUCT: WINUSB_SETUP_PACKET
+    { RequestType   UCHAR  }
+    { Request       UCHAR  }
+    { Value         USHORT }
+    { Index         USHORT }
+    { Length        USHORT } ;
+TYPEDEF: WINUSB_SETUP_PACKET* PWINUSB_SETUP_PACKET
+
+FUNCTION: BOOL WinUsb_AbortPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID ) ;
+FUNCTION: BOOL WinUsb_FlushPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID ) ;
+FUNCTION: BOOL WinUsb_ControlTransfer ( WINUSB_INTERFACE_HANDLE InterfaceHandle, WINUSB_SETUP_PACKET SetupPacket, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred, LPOVERLAPPED Overlapped ) ;
+FUNCTION: BOOL WinUsb_Initialize ( HANDLE DeviceHandle, PWINUSB_INTERFACE_HANDLE InterfaceHandle ) ;
+FUNCTION: BOOL WinUsb_Free ( WINUSB_INTERFACE_HANDLE InterfaceHandle ) ;
+FUNCTION: BOOL WinUsb_GetAssociatedInterface ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR AssociatedInterfaceIndex, PWINUSB_INTERFACE_HANDLE AssociatedInterfaceHandle ) ;
+FUNCTION: BOOL WinUsb_GetCurrentAlternateSetting ( WINUSB_INTERFACE_HANDLE InterfaceHandle, PUCHAR SettingNumber ) ;
+FUNCTION: BOOL WinUsb_GetDescriptor ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR DescriptorType, UCHAR Index, USHORT LanguageID, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred ) ;
+FUNCTION: BOOL WinUsb_GetPowerPolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, ULONG PolicyType, PULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_GetOverlappedResult ( WINUSB_INTERFACE_HANDLE InterfaceHandle, LPOVERLAPPED lpOverlapped, LPDWORD lpNumberOfBytesTransferred, BOOL bWait ) ;
+FUNCTION: BOOL WinUsb_GetPipePolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, ULONG PolicyType, PULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_QueryInterfaceSettings ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR AlternateInterfaceNumber, PUSB_INTERFACE_DESCRIPTOR UsbAltInterfaceDescriptor ) ;
+FUNCTION: BOOL WinUsb_QueryDeviceInformation ( WINUSB_INTERFACE_HANDLE InterfaceHandle, ULONG InformationType, PULONG BufferLength, PVOID Buffer ) ;
+FUNCTION: BOOL WinUsb_QueryPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR AlternateInterfaceNumber, UCHAR PipeIndex, PWINUSB_PIPE_INFORMATION PipeInformation ) ;
+FUNCTION: BOOL WinUsb_ReadPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred, LPOVERLAPPED Overlapped ) ;
+FUNCTION: BOOL WinUsb_ResetPipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID ) ;
+FUNCTION: BOOL WinUsb_SetCurrentAlternateSetting ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR SettingNumber ) ;
+FUNCTION: BOOL WinUsb_SetPowerPolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, ULONG PolicyType, ULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_SetPipePolicy ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, ULONG PolicyType, ULONG ValueLength, PVOID Value ) ;
+FUNCTION: BOOL WinUsb_WritePipe ( WINUSB_INTERFACE_HANDLE InterfaceHandle, UCHAR PipeID, PUCHAR Buffer, ULONG BufferLength, PULONG LengthTransferred, LPOVERLAPPED Overlapped ) ;

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." } ;
 

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

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 )) }
     { "<wrapper>" "kernel" "primitive_wrapper" (( obj -- wrapper )) }
     { "callstack" "kernel" "primitive_callstack" (( -- cs )) }

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

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
+{ $contract "Outputs one of " { $link +byte+ } " or " { $link +character+ } "." } ;
-  "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" } "."
-  
-} ;
 
 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" } }
+{ $values { "data" "binary data or a 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." }
+{ $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
+{ $subsections "stream-types" }
-"The following word is required for all input and output streams:"
-{ $subsections stream-element-type }
 "These words are required for binary and string input streams:"
 { $subsections
     stream-read1

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 -- )
 

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

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 <file-reader> } " or " { $link <file-writer> } " to get a high level stream." } ;
 
-HELP: fwrite ( string alien -- )
+HELP: fwrite
-{ $values { "string" "a string" } { "alien" "a C FILE* handle" } }
+{ $values { "data" c-ptr } { "length" integer } { "alien" "a C FILE* handle" } }
-{ $description "Writes a string of text to 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." } ;
 

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 <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

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
+USING: alien alien.strings kernel kernel.private namespaces make
-math generic threads.private classes io.backend io.files
+io io.encodings sequences math generic threads.private classes
-io.encodings.utf8 alien.strings continuations destructors byte-arrays
+io.backend io.files io.encodings.utf8 continuations destructors
-accessors combinators ;
+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 ;
+        } 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 ;

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
+USING: accessors alien alien.c-types audio.engine byte-arrays
-combinators destructors fry io io.files io.encodings.binary
+classes.struct combinators destructors fry io io.files
-kernel libc locals make math math.order math.parser ogg ogg.vorbis
+io.encodings.binary kernel libc locals make math math.order
-sequences specialized-arrays specialized-vectors ;
+math.parser ogg ogg.vorbis sequences specialized-arrays
+specialized-vectors ;
 FROM: alien.c-types => float short void* ;
 SPECIALIZED-ARRAYS: float void* ;
 SPECIALIZED-VECTOR: short

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
+byte-vectors combinators formatting fry io io.binary
-io.encodings.binary io.encodings.string io.encodings.utf8 io.encodings.utf8.private io.files
+io.encodings.private io.encodings.binary io.encodings.string
-kernel locals math mongodb.msg namespaces sequences uuid bson.writer.private ;
+io.encodings.utf8 io.encodings.utf8.private io.files kernel
-
+locals math mongodb.msg namespaces sequences uuid
-IN: alien.c-types
+bson.writer.private ;
-
-M: byte-vector byte-length length ;
-
 IN: mongodb.operations
 
 <PRIVATE

extra/synth/buffers/buffers.factor

@@ -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

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 = to_cell(ctx->pop());
-	cell length = array_capacity(text);
+	char *text = alien_offset(ctx->pop());
-	char *string = (char *)(text + 1);
 
 	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);
 }