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

Byte-array-ification

db4
Slava Pestov 2008-03-07 21:26:35 -06:00
parent 50a2c51187
commit 2fa5f34a71
9 changed files with 29 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
core/alien/c-types/c-types-docs.factor
View File

@ -88,29 +88,11 @@ HELP: memory>byte-array ( base len -- string )
{ $values { "base" 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: memory>char-string ( base len -- string )
{ $values { "base" c-ptr } { "len" "a non-negative integer" } { "string" string } }
{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new string." } ;
HELP: memory>u16-string ( base len -- string )
{ $values { "base" c-ptr } { "len" "a non-negative integer" } { "string" string } }
{ $description "Reads " { $snippet "len" } " UCS2 characters starting from " { $snippet "base" } " and stores them in a new string." } ;
HELP: byte-array>memory ( string base -- )
{ $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: string>char-memory ( string base -- )
{ $values { "string" string } { "base" c-ptr } }
{ $description "Writes a string to memory starting from the " { $snippet "base" } " address." }
{ $warning "This word is unsafe. Improper use can corrupt memory." } ;
HELP: string>u16-memory ( string base -- )
{ $values { "string" string } { "base" c-ptr } }
{ $description "Writes a string 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" } { "alien" alien } }
{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type." }
@ -293,11 +275,7 @@ ARTICLE: "c-strings" "C strings"
$nl
"Finally, a set of words can be used to read and write " { $snippet "char*" } " and " { $snippet "ushort*" } " strings at arbitrary addresses:"
{ $subsection alien>char-string }
{ $subsection alien>u16-string }
{ $subsection memory>char-string }
{ $subsection memory>u16-string }
{ $subsection string>char-memory }
{ $subsection string>u16-memory } ;
{ $subsection alien>u16-string } ;
ARTICLE: "c-data" "Passing data between Factor and C"
"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers. Also Factor's garbage collector can move objects in memory, which means that special support has to be provided for passing blocks of memory to C code."

13
core/alien/c-types/c-types.factor
View File

@ -155,20 +155,9 @@ M: float-array byte-length length "double" heap-size * ;
: memory>byte-array ( alien len -- byte-array )
dup <byte-array> [ -rot memcpy ] keep ;
: memory>char-string ( alien len -- string )
memory>byte-array >string ;
DEFER: c-ushort-array>
: memory>u16-string ( alien len -- string )
[ memory>byte-array ] keep 2/ c-ushort-array> >string ;
: byte-array>memory ( byte-array base -- )
swap dup length memcpy ;
: string>char-memory ( string base -- )
>r B{ } like r> byte-array>memory ;
DEFER: >c-ushort-array
: string>u16-memory ( string base -- )
@ -274,7 +263,7 @@ M: long-long-type box-return ( type -- )
] when ;
: malloc-file-contents ( path -- alien )
binary file-contents >byte-array malloc-byte-array ;
binary file-contents malloc-byte-array ;
[
[ alien-cell ]

4
core/io/binary/binary-tests.factor
View File

@ -1,8 +1,8 @@
USING: io.binary tools.test ;
IN: io.binary.tests
[ "\0\0\u000004\u0000d2" ] [ 1234 4 >be ] unit-test
[ "\u0000d2\u000004\0\0" ] [ 1234 4 >le ] unit-test
[ B{ 0 0 4 HEX: d2 } ] [ 1234 4 >be ] unit-test
[ B{ HEX: d2 4 0 0 } ] [ 1234 4 >le ] unit-test
[ 1234 ] [ 1234 4 >be be> ] unit-test
[ 1234 ] [ 1234 4 >le le> ] unit-test

12
core/io/files/files-tests.factor
View File

@ -6,9 +6,8 @@ USING: tools.test io.files io threads kernel continuations io.encodings.ascii ;
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
[ ] [
"test-foo.txt" temp-file ascii [
"Hello world." print
] with-file-writer
{ "Hello world." }
"test-foo.txt" temp-file ascii set-file-lines
] unit-test
[ ] [
@ -69,8 +68,8 @@ USING: tools.test io.files io threads kernel continuations io.encodings.ascii ;
[ ] [ "delete-tree-test/a/b/c" temp-file make-directories ] unit-test
[ ] [
"delete-tree-test/a/b/c/d" temp-file
ascii [ "Hi" print ] with-file-writer
{ "Hi" }
"delete-tree-test/a/b/c/d" temp-file ascii set-file-lines
] unit-test
[ ] [
@ -82,8 +81,9 @@ USING: tools.test io.files io threads kernel continuations io.encodings.ascii ;
] unit-test
[ ] [
"Foobar"
"copy-tree-test/a/b/c/d" temp-file
ascii [ "Foobar" write ] with-file-writer
ascii set-file-contents
] unit-test
[ ] [

10
core/io/files/files.factor
View File

@ -213,15 +213,15 @@ C: <pathname> pathname
M: pathname <=> [ pathname-string ] compare ;
: file-lines ( path encoding -- seq ) <file-reader> lines ;
: file-contents ( path encoding -- str )
dupd <file-reader> swap file-length <sbuf>
[ stream-copy ] keep >string ;
: file-lines ( path encoding -- seq )
<file-reader> lines ;
: with-file-reader ( path encoding quot -- )
>r <file-reader> r> with-stream ; inline
: file-contents ( path encoding -- str )
dupd [ file-length read ] with-file-reader ;
: with-file-writer ( path encoding quot -- )
>r <file-writer> r> with-stream ; inline

4
core/io/streams/c/c-tests.factor
View File

@ -3,9 +3,7 @@ io.encodings.ascii strings ;
IN: io.streams.c.tests
[ "hello world" ] [
"test.txt" temp-file ascii [
"hello world" write
] with-file-writer
"hello world" "test.txt" temp-file ascii set-file-contents
"test.txt" temp-file "rb" fopen <c-reader> contents
>string

22
extra/io/buffers/buffers.factor
View File

@ -3,7 +3,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io.buffers
USING: alien alien.accessors alien.c-types alien.syntax kernel
kernel.private libc math sequences strings hints ;
kernel.private libc math sequences byte-arrays strings hints ;
TUPLE: buffer size ptr fill pos ;
@ -37,18 +37,18 @@ TUPLE: buffer size ptr fill pos ;
: buffer-pop ( buffer -- ch )
dup buffer-peek 1 rot buffer-consume ;
: (buffer>) ( n buffer -- string )
: (buffer>) ( n buffer -- byte-array )
[ dup buffer-fill swap buffer-pos - min ] keep
buffer@ swap memory>char-string ;
buffer@ swap memory>byte-array ;
: buffer> ( n buffer -- string )
: buffer> ( n buffer -- byte-array )
[ (buffer>) ] 2keep buffer-consume ;
: (buffer>>) ( buffer -- string )
: (buffer>>) ( buffer -- byte-array )
dup buffer-pos over buffer-ptr <displaced-alien>
over buffer-fill rot buffer-pos - memory>char-string ;
over buffer-fill rot buffer-pos - memory>byte-array ;
: buffer>> ( buffer -- string )
: buffer>> ( buffer -- byte-array )
dup (buffer>>) 0 rot buffer-reset ;
: search-buffer-until ( start end alien separators -- n )
@ -56,7 +56,7 @@ TUPLE: buffer size ptr fill pos ;
HINTS: search-buffer-until { fixnum fixnum simple-alien string } ;
: finish-buffer-until ( buffer n -- string separator )
: finish-buffer-until ( buffer n -- byte-array separator )
[
over buffer-pos -
over buffer>
@ -65,7 +65,7 @@ HINTS: search-buffer-until { fixnum fixnum simple-alien string } ;
buffer>> f
] if* ;
: buffer-until ( separators buffer -- string separator )
: buffer-until ( separators buffer -- byte-array separator )
tuck { buffer-pos buffer-fill buffer-ptr } get-slots roll
search-buffer-until finish-buffer-until ;
@ -85,9 +85,9 @@ HINTS: search-buffer-until { fixnum fixnum simple-alien string } ;
: check-overflow ( n buffer -- )
2dup buffer-capacity > [ extend-buffer ] [ 2drop ] if ;
: >buffer ( string buffer -- )
: >buffer ( byte-array buffer -- )
over length over check-overflow
[ buffer-end string>char-memory ] 2keep
[ buffer-end byte-array>memory ] 2keep
[ buffer-fill swap length + ] keep set-buffer-fill ;
: ch>buffer ( ch buffer -- )

2
extra/io/mmap/mmap-tests.factor
View File

@ -3,7 +3,7 @@ sequences io.encodings.ascii ;
IN: io.mmap.tests
[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors
[ ] [ "mmap-test-file.txt" resource-path ascii [ "12345" write ] with-file-writer ] unit-test
[ ] [ "12345" "mmap-test-file.txt" resource-path ascii set-file-contents ] unit-test
[ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
[ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test
[ "22345" ] [ "mmap-test-file.txt" resource-path ascii file-contents ] unit-test

2
extra/io/unix/files/files.factor
View File

@ -68,7 +68,7 @@ M: unix-io delete-directory ( path -- )
] with-disposal ;
M: unix-io copy-file ( from to -- )
>r dup file-permissions over r> (copy-file) chmod io-error ;
[ (copy-file) ] 2keep swap file-permissions chmod io-error ;
: stat>type ( stat -- type )
stat-st_mode {