{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
-HELP: byte-array>memory
-{ $values { "byte-array" byte-array } { "base" c-ptr } }
-{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
-{ $warning "This word is unsafe. Improper use can corrupt memory." } ;
-
HELP: malloc-array
{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" "a specialized array" } }
{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-direct-array> } "." }
"You can unsafely copy a range of bytes from one memory location to another:"
{ $subsections memcpy }
"You can copy a range of bytes from memory into a byte array:"
-{ $subsections memory>byte-array }
-"You can copy a byte array to memory unsafely:"
-{ $subsections byte-array>memory } ;
+{ $subsections memory>byte-array } ;
ARTICLE: "c-pointers" "Passing pointers to C functions"
"The following Factor objects may be passed to C function parameters with pointer types:"
{ "Instances of " { $link alien } "." }
{ "Instances of " { $link f } "; this is interpreted as a null pointer." }
{ "Instances of " { $link byte-array } "; the C function receives a pointer to the first element of the array." }
- { "Any data type which defines a method on " { $link >c-ptr } " that returns an instance of one of the above. This includes " { $link "classes.struct" } " and " { $link "specialized-arrays" } "." }
+ { "Any data type which defines a method on " { $link >c-ptr } ". This includes " { $link "classes.struct" } " and " { $link "specialized-arrays" } "." }
}
"The class of primitive C pointer types:"
{ $subsections c-ptr }
heap-size malloc ; inline
: malloc-byte-array ( byte-array -- alien )
- dup byte-length [ nip malloc dup ] 2keep memcpy ;
+ binary-object [ nip malloc dup ] 2keep memcpy ;
: memory>byte-array ( alien len -- byte-array )
[ nip (byte-array) dup ] 2keep memcpy ;
swap memory>byte-array
] [ [ + ] change-index drop ] 2bi ;
-: 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 ;
+ [ dup byte-length tail-slice ]
+ [ [ [ byte-length ] bi@ + ] keep lengthen ]
+ [ drop byte-length ]
+ 2tri
+ [ >c-ptr swap >c-ptr ] dip memcpy ;
M: value-type c-type-rep drop int-rep ;
! See http://factorcode.org/license.txt for BSD license.
USING: combinators io io.binary io.encodings.binary
io.streams.byte-array kernel math namespaces
-sequences strings io.crlf ;
+sequences strings ;
IN: base64
ERROR: malformed-base64 ;
: write1-lines ( ch -- )
write1
column get [
- 1 + [ 76 = [ crlf ] when ]
+ 1 + [ 76 = [ B{ CHAR: \r CHAR: \n } write ] when ]
[ 76 mod column set ] bi
] when* ;
strings accessors destructors ;
: buffer-set ( string buffer -- )
- over >byte-array over ptr>> byte-array>memory
- [ length ] dip buffer-reset ;
+ [ ptr>> swap >byte-array binary-object memcpy ]
+ [ [ length ] dip buffer-reset ]
+ 2bi ;
: string>buffer ( string -- buffer )
dup length <buffer> [ buffer-set ] keep ;
HINTS: n>buffer fixnum buffer ;
: >buffer ( byte-array buffer -- )
- [ buffer-end byte-array>memory ]
+ [ buffer-end swap binary-object memcpy ]
[ [ byte-length ] dip n>buffer ]
2bi ;
[ { CHAR: replacement-character } ] [ B{ 0 } utf32be decode >array ] unit-test
[ { } ] [ { } utf32be decode >array ] unit-test
-[ { 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } >string utf32be encode >array ] unit-test
+[ B{ 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } >string utf32be encode ] unit-test
[ { CHAR: x } ] [ B{ CHAR: x 0 0 0 } utf32le decode >array ] unit-test
[ { HEX: 1d11e } ] [ B{ HEX: 1e HEX: d1 1 0 } utf32le decode >array ] unit-test
[ { CHAR: replacement-character } ] [ B{ HEX: 1e } utf32le decode >array ] unit-test
[ { } ] [ { } utf32le decode >array ] unit-test
-[ { 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32le encode >array ] unit-test
+[ B{ 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32le encode ] unit-test
[ { CHAR: x } ] [ B{ HEX: ff HEX: fe 0 0 CHAR: x 0 0 0 } utf32 decode >array ] unit-test
[ { CHAR: x } ] [ B{ 0 0 HEX: fe HEX: ff 0 0 0 CHAR: x } utf32 decode >array ] unit-test
-[ { HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32 encode >array ] unit-test
+[ B{ HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32 encode ] unit-test
-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
-specialized-arrays alien.c-types classes.struct alien ;
+USING: destructors io io.directories io.encodings.binary
+io.files io.files.temp kernel libc math sequences
+specialized-arrays.instances.alien.c-types.int tools.test ;
IN: io.ports.tests
! Make sure that writing malloced storage to a file works, and
[ ] [
"test.txt" temp-file binary [
- 100,000 iota
- 0
- 100,000 malloc-int-array &dispose [ copy ] keep write
+ [
+ 100,000 iota
+ 0
+ 100,000 malloc-int-array &free [ copy ] keep write
+ ] with-destructors
] with-file-writer
] unit-test
] with-file-reader
] unit-test
-USE: multiline
-/*
-[ ] [
- BV{ 0 1 2 } "test.txt" temp-file binary set-file-contents
-] unit-test
-
-[ t ] [
- "test.txt" temp-file binary file-contents
- B{ 0 1 2 } =
-] unit-test
-
-STRUCT: pt { x uint } { y uint } ;
-SPECIALIZED-ARRAY: pt
-
-CONSTANT: pt-array-1
- pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
-
-[ ] [
- pt-array-1
- "test.txt" temp-file binary set-file-contents
-] unit-test
-
-[ t ] [
- "test.txt" temp-file binary file-contents
- pt-array-1 >c-ptr sequence=
-] unit-test
-
-[ ] [
- pt-array-1 rest-slice
- "test.txt" temp-file binary set-file-contents
-] unit-test
-
-[ t ] [
- "test.txt" temp-file binary file-contents
- pt-array-1 rest-slice >c-ptr sequence=
-] unit-test
-
-*/
-
[ ] [ "test.txt" temp-file delete-file ] unit-test
USING: tools.test kernel serialize io io.streams.byte-array
alien arrays byte-arrays bit-arrays specialized-arrays
sequences math prettyprint parser classes math.constants
-io.encodings.binary random assocs serialize.private alien.c-types ;
+io.encodings.binary random assocs serialize.private alien.c-types
+combinators.short-circuit ;
SPECIALIZED-ARRAY: double
IN: serialize.tests
[ t ] [
100 [
drop
- 40 [ test-serialize-cell ] all-integers?
- 4 [ 40 * test-serialize-cell ] all-integers?
- 4 [ 400 * test-serialize-cell ] all-integers?
- 4 [ 4000 * test-serialize-cell ] all-integers?
- and and and
+ {
+ [ 40 [ test-serialize-cell ] all-integers? ]
+ [ 4 [ 40 * test-serialize-cell ] all-integers? ]
+ [ 4 [ 400 * test-serialize-cell ] all-integers? ]
+ [ 4 [ 4000 * test-serialize-cell ] all-integers? ]
+ } 0&&
] all-integers?
] unit-test
IN: specialized-arrays.tests
USING: tools.test alien.syntax specialized-arrays
-specialized-arrays.private sequences alien.c-types accessors
+specialized-arrays.private sequences alien accessors
kernel arrays combinators compiler compiler.units classes.struct
combinators.smart compiler.tree.debugger math libc destructors
sequences.private multiline eval words vocabs namespaces
assocs prettyprint alien.data math.vectors definitions
compiler.test ;
-FROM: alien.c-types => float ;
+FROM: alien.c-types => int float bool char float ulonglong ushort uint
+heap-size little-endian? ;
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
] [ drop ] 2bi
<direct-A> ; inline
-M: A byte-length length \ T heap-size * ; inline
+M: A element-size drop \ T heap-size ; inline
M: A direct-array-syntax drop \ A@ ;
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.parser assocs
compiler.units functors growable kernel lexer math namespaces
M: V contract 2drop ; inline
-M: V byte-length length \ T heap-size * ; inline
+M: V element-size drop \ T heap-size ; inline
M: V pprint-delims drop \ V{ \ } ;
dup win32-error=0/f
dup GlobalLock dup win32-error=0/f
- swapd byte-array>memory
+ rot binary-object memcpy
dup GlobalUnlock win32-error=0/f
CF_UNICODETEXT swap SetClipboardData win32-error=0/f
] with-clipboard ;
call swap set-global ; inline
: (malloc-guid-symbol) ( symbol guid -- )
- '[
- _ execute( -- value )
- [ byte-length malloc ] [ over byte-array>memory ] bi
- ] initialize ;
+ '[ _ execute( -- value ) malloc-byte-array ] initialize ;
: define-guid-constants ( -- )
{
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 kernel ;
+alien.libraries alien.c-types quotations kernel
+sequences ;
IN: alien
HELP: >c-ptr
-{ $values { "object" object } { "c-ptr" c-ptr } }
+{ $values { "obj" 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" } }
+{ $values { "obj" 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: element-size
+{ $values { "seq" sequence } { "n" "a non-negative integer" } }
+{ $contract "Outputs the number of bytes used for each element of the sequence." }
+{ $notes "If a sequence class implements " { $link element-size } " and " { $link >c-ptr } ", then instances of this sequence, as well as slices of this sequence, can be used as binary objects." } ;
+
+{ >c-ptr element-size 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." } ;
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences system
-kernel.private byte-arrays arrays init ;
+kernel.private byte-arrays byte-vectors arrays init ;
IN: alien
PREDICATE: pinned-alien < alien underlying>> not ;
UNION: pinned-c-ptr pinned-alien POSTPONE: f ;
-GENERIC: >c-ptr ( obj -- c-ptr ) flushable
+GENERIC: element-size ( seq -- n ) flushable
-M: c-ptr >c-ptr ; inline
+M: byte-array element-size drop 1 ; inline
-GENERIC: byte-length ( seq -- n ) flushable
+M: byte-vector element-size drop 1 ; inline
-M: byte-array byte-length length ; inline
+M: slice element-size seq>> element-size ; inline
-M: f byte-length drop 0 ; inline
+M: f element-size drop 1 ; inline
-: binary-object ( obj -- c-ptr n )
- [ >c-ptr ] [ byte-length ] bi ; inline
+GENERIC: byte-length ( obj -- n ) flushable
+
+M: object byte-length [ length ] [ element-size ] bi * ; inline
+
+GENERIC: >c-ptr ( obj -- c-ptr ) flushable
+
+M: c-ptr >c-ptr ; inline
+
+M: slice >c-ptr
+ [ [ from>> ] [ element-size ] bi * ] [ seq>> >c-ptr ] bi
+ <displaced-alien> ; inline
SLOT: underlying
M: object >c-ptr underlying>> ; inline
+: binary-object ( obj -- c-ptr n )
+ [ >c-ptr ] [ byte-length ] bi ; inline
+
GENERIC: expired? ( c-ptr -- ? ) flushable
M: alien expired? expired>> ;
-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 specialized-arrays alien.c-types ;
+USING: alien alien.c-types arrays classes.struct
+debugger.threads destructors generic.single io io.directories
+io.encodings.8-bit.latin1 io.encodings.ascii
+io.encodings.binary io.encodings.string io.files
+io.files.private io.files.temp io.files.unique kernel make math
+sequences specialized-arrays system threads tools.test ;
SPECIALIZED-ARRAY: int
IN: io.files.tests
byte-array>int-array
] unit-test
+[ ] [
+ BV{ 0 1 2 } "test.txt" temp-file binary set-file-contents
+] unit-test
+
+[ t ] [
+ "test.txt" temp-file binary file-contents
+ B{ 0 1 2 } =
+] unit-test
+
+STRUCT: pt { x uint } { y uint } ;
+SPECIALIZED-ARRAY: pt
+
+CONSTANT: pt-array-1
+ pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
+
+[ ] [
+ pt-array-1
+ "test.txt" temp-file binary set-file-contents
+] unit-test
+
+[ t ] [
+ "test.txt" temp-file binary file-contents
+ pt-array-1 >c-ptr sequence=
+] unit-test
+
+! Slices should support >c-ptr and byte-length
+
+[ ] [
+ pt-array-1 rest-slice
+ "test.txt" temp-file binary set-file-contents
+] unit-test
+
+[ t ] [
+ "test.txt" temp-file binary file-contents
+ byte-array>pt-array
+ pt-array-1 rest-slice sequence=
+] unit-test
+
! Writing strings to binary streams should fail
[
"test.txt" temp-file binary [
[ B{ } ] [ B{ } binary [ contents ] with-byte-reader ] unit-test
[ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
+[ B{ 1 2 3 4 5 6 } ] [ binary [ B{ 1 2 3 } write B{ 4 5 6 } write ] with-byte-writer ] unit-test
[ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
[ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ]
projects / factor.git / commitdiff