steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Specialized arrays, structs and other objects responding to the >c-ptr / byte-length protocol can now be written to binary streams

db4
Slava Pestov 2010-02-24 20:18:41 +13:00
parent 0975b9a268
commit af0ddd5985
29 changed files with 212 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/alien/c-types/c-types-docs.factor
View 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." }

6
basis/alien/c-types/c-types.factor
View 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

11
basis/alien/data/data.factor
View 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

2
basis/bit-arrays/bit-arrays.factor
View 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

6
basis/classes/struct/struct.factor
View 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
@ -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 ]

2
basis/io/buffers/buffers.factor
View 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 ;

23
basis/io/ports/ports-tests.factor Normal file
View File

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

22
basis/io/ports/ports.factor
View 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 ;

3
basis/math/bitwise/bitwise.factor
View 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? ;

8
basis/math/vectors/conversion/conversion.factor
View 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 ;

12
basis/math/vectors/simd/simd.factor
View 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 ]

2
basis/nibble-arrays/nibble-arrays.factor
View 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

4
basis/specialized-arrays/specialized-arrays.factor
View 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:

6
basis/specialized-vectors/specialized-vectors.factor
View 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

6
basis/stack-checker/known-words/known-words.factor
View 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

12
core/alien/alien-docs.factor
View 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." } ;

11
core/alien/alien.factor
View 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

2
core/bootstrap/primitives.factor
View 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 )) }

27
core/io/files/files-tests.factor
View 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

34
core/io/io-docs.factor
View 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

2
core/io/io.factor
View 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 -- )

11
core/io/streams/byte-array/byte-array-tests.factor
View 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

10
core/io/streams/c/c-docs.factor
View 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." } ;

25
core/io/streams/c/c-tests.factor
View 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

30
core/io/streams/c/c.factor
View 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 ;

9
extra/audio/vorbis/vorbis.factor
View 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

13
extra/mongodb/operations/operations.factor
View 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

4
extra/synth/buffers/buffers.factor
View 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

9
vm/io.cpp
View File

@ -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);
}