diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor
index 6ab6d56bc7..4600ea6837 100644
--- a/basis/alien/data/data-docs.factor
+++ b/basis/alien/data/data-docs.factor
@@ -21,11 +21,6 @@ HELP: memory>byte-array
{ $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> } "." }
@@ -75,9 +70,7 @@ $nl
"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:"
@@ -85,7 +78,7 @@ ARTICLE: "c-pointers" "Passing pointers to C functions"
{ "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 }
diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor
index 462bed8b76..2d572e9f13 100644
--- a/basis/alien/data/data.factor
+++ b/basis/alien/data/data.factor
@@ -49,7 +49,7 @@ M: word <c-direct-array>
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 ;
@@ -63,14 +63,12 @@ M: memory-stream stream-read
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 ;
diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor
index 1a0648cef8..9a57740936 100644
--- a/basis/base64/base64.factor
+++ b/basis/base64/base64.factor
@@ -2,7 +2,7 @@
! 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 ;
@@ -35,7 +35,7 @@ SYMBOL: column
: 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* ;
diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor
index 836b4d0cc8..07e783f267 100644
--- a/basis/io/buffers/buffers-tests.factor
+++ b/basis/io/buffers/buffers-tests.factor
@@ -4,8 +4,9 @@ kernel.private libc sequences tools.test namespaces byte-arrays
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 ;
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index ce5ad2c9a0..562abad082 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -60,7 +60,7 @@ HINTS: buffer-read fixnum buffer ;
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 ;
diff --git a/basis/io/encodings/utf32/utf32-tests.factor b/basis/io/encodings/utf32/utf32-tests.factor
index 2a80e47c7b..adff0ecf4b 100644
--- a/basis/io/encodings/utf32/utf32-tests.factor
+++ b/basis/io/encodings/utf32/utf32-tests.factor
@@ -12,7 +12,7 @@ IN: io.encodings.utf32.tests
[ { 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
@@ -21,10 +21,10 @@ IN: io.encodings.utf32.tests
[ { 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
diff --git a/basis/io/ports/ports-tests.factor b/basis/io/ports/ports-tests.factor
index e637999880..c7af6909e1 100644
--- a/basis/io/ports/ports-tests.factor
+++ b/basis/io/ports/ports-tests.factor
@@ -1,5 +1,5 @@
-USING: destructors io io.encodings.binary io.files io.directories
-io.files.temp io.ports kernel sequences math
+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
@@ -8,9 +8,11 @@ IN: io.ports.tests
[ ] [
"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
diff --git a/basis/serialize/serialize-tests.factor b/basis/serialize/serialize-tests.factor
index 036356e137..9213a54004 100644
--- a/basis/serialize/serialize-tests.factor
+++ b/basis/serialize/serialize-tests.factor
@@ -4,7 +4,8 @@
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
@@ -16,11 +17,12 @@ 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
diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor
index c25f8ae3b1..645606edc5 100644
--- a/basis/specialized-arrays/specialized-arrays-tests.factor
+++ b/basis/specialized-arrays/specialized-arrays-tests.factor
@@ -1,12 +1,13 @@
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 ;
diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index f7070c68e1..b052becfed 100644
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -95,7 +95,7 @@ M: A resize
] [ 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@ ;
diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor
index c16fe2510d..0c0569ea9d 100644
--- a/basis/specialized-vectors/specialized-vectors.factor
+++ b/basis/specialized-vectors/specialized-vectors.factor
@@ -1,4 +1,4 @@
-! 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
@@ -26,7 +26,7 @@ V A <A> vectors.functor:define-vector
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{ \ } ;
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 5863d3f39d..0bf2e88468 100644
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -212,7 +212,7 @@ PRIVATE>
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 ;
diff --git a/basis/windows/directx/dinput/constants/constants.factor b/basis/windows/directx/dinput/constants/constants.factor
index 26f9da00ec..ba4d750174 100644
--- a/basis/windows/directx/dinput/constants/constants.factor
+++ b/basis/windows/directx/dinput/constants/constants.factor
@@ -72,10 +72,7 @@ M: array array-base-type first ;
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 ( -- )
{
diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor
index 60c1cdaf69..99f3a2b0f4 100644
--- a/core/alien/alien-docs.factor
+++ b/core/alien/alien-docs.factor
@@ -1,18 +1,24 @@
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." } ;
diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index 42f48f97aa..3802147838 100644
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -1,30 +1,42 @@
! 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: element-size ( seq -- n ) flushable
+
+M: byte-array element-size drop 1 ; inline
+
+M: byte-vector element-size drop 1 ; inline
+
+M: slice element-size seq>> element-size ; inline
+
+M: f element-size drop 1 ; 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
-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
+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>> ;
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index cf58dbfe05..5db1822d9e 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -1,8 +1,9 @@
-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
@@ -80,6 +81,44 @@ 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 [
diff --git a/core/io/streams/byte-array/byte-array-tests.factor b/core/io/streams/byte-array/byte-array-tests.factor
index dc95d454fa..46e015e576 100644
--- a/core/io/streams/byte-array/byte-array-tests.factor
+++ b/core/io/streams/byte-array/byte-array-tests.factor
@@ -6,6 +6,7 @@ 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
+[ 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 } ]
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index dc26933af4..46b4dcd4ec 100644
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -1617,8 +1617,8 @@ ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
}
"The second reason is much weaker than the first one. In particular, many combinators (see " { $link map } ", " { $link produce } " and " { $link "namespaces-make" } ") as well as more advanced data structures (such as " { $vocab-link "persistent.vectors" } ") alleviate the need for explicit use of side effects." ;
-ARTICLE: "sequences-destructive" "Destructive operations"
-"Many operations have constructive and destructive variants:"
+ARTICLE: "sequences-destructive" "Destructive sequence operations"
+"Many operations have destructive variants that side effect an input sequence, instead of creating a new sequence:"
{ $table
{ "Constructive" "Destructive" }
{ { $link suffix } { $link suffix! } }
@@ -1641,10 +1641,14 @@ ARTICLE: "sequences-destructive" "Destructive operations"
delete-all
filter!
}
+"Adding elements:"
+{ $subsections
+ suffix!
+ append!
+}
"Other destructive words:"
{ $subsections
reverse!
- append!
move
exchange
copy
diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
index 6bdc449dc8..bd2b897c0e 100644
--- a/extra/webapps/wiki/wiki-common.xml
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -15,7 +15,7 @@
<div class="contents">
<t:bind t:name="contents">
<h2>
- <t:a t:href="$wiki/view" t:query="title">
+ <t:a t:href="$wiki/view" t:rest="title">
<t:label t:name="title" />
</t:a>
</h2>