vocabs.loader classes.struct quotations kernel ;
IN: alien.data
+HELP: >c-array
+{ $values { "seq" sequence } { "c-type" "a C type" } { "array" byte-array } }
+{ $description "Outputs a freshly allocated byte-array whose elements are C type values from the given sequence." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
+
HELP: <c-array>
{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } }
{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
+HELP: c-array{
+{ $description "Literal syntax, consists of a C-type followed by a series of values terminated by " { $snippet "}" } }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
+
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: cast-array
+{ $values { "byte-array" byte-array } { "c-type" "a C type" } { "array" "a specialized array" } }
+{ $description "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
+
HELP: malloc-array
-{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" "a specialized array" } }
+{ $values { "n" "a non-negative integer" } { "c-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> } "." }
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
-USING: accessors alien alien.c-types alien.arrays alien.strings
-arrays byte-arrays cpu.architecture fry io io.encodings.binary
-io.files io.streams.memory kernel libc math math.functions
-sequences words macros combinators generalizations
-stack-checker.dependencies combinators.short-circuit ;
+USING: accessors alien alien.arrays alien.c-types alien.strings
+arrays byte-arrays combinators combinators.short-circuit
+cpu.architecture fry generalizations io io.streams.memory kernel
+libc macros math math.functions parser sequences
+stack-checker.dependencies summary words ;
QUALIFIED: math
IN: alien.data
GENERIC: c-direct-array-constructor ( c-type -- word ) foldable
+GENERIC: c-array-type ( c-type -- word ) foldable
+
+GENERIC: c-array-type? ( c-type -- word ) foldable
+
+GENERIC: c-array? ( obj c-type -- ? ) foldable
+
+M: word c-array?
+ c-array-type? execute( seq -- array ) ; inline
+
+M: pointer c-array?
+ drop void* c-array? ;
+
+GENERIC: >c-array ( seq c-type -- array )
+
+M: word >c-array
+ c-array-type new clone-like ;
+
+M: pointer >c-array
+ drop void* >c-array ;
+
GENERIC: <c-array> ( len c-type -- array )
M: word <c-array>
M: pointer <c-direct-array>
drop void* <c-direct-array> ;
-: malloc-array ( n type -- array )
+SYNTAX: c-array{ \ } [ unclip >c-array ] parse-literal ;
+
+SYNTAX: c-array@
+ scan-object [ scan-object scan-object ] dip
+ <c-direct-array> suffix! ;
+
+ERROR: bad-byte-array-length byte-array type ;
+
+M: bad-byte-array-length summary
+ drop "Byte array length doesn't divide type width" ;
+
+: cast-array ( byte-array c-type -- array )
+ [ binary-object ] dip [ heap-size /mod 0 = ] keep swap
+ [ <c-direct-array> ] [ bad-byte-array-length ] if ; inline
+
+: malloc-array ( n c-type -- array )
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
: malloc-byte-array ( byte-array -- alien )
] unless ;
: uint-array-cast-le ( byte-array -- uint-array )
- byte-array>le uint-array-cast ;
+ byte-array>le uint cast-array ;
HINTS: uint-array-cast-le byte-array ;
{ $code "test-struct <struct> ." }
"Creating a new instance with slots initialized from the stack:"
{ $code
- "USING: libc specialized-arrays ;"
+ "USING: libc specialized-arrays alien.data ;"
"SPECIALIZED-ARRAY: char"
""
"42"
- "\"Hello, chicken.\" >char-array"
+ "\"Hello, chicken.\" char >c-array"
"1024 malloc"
"test-struct <struct-boa> ."
} ;
[ t ] [
[ struct-test-optimization memory>struct x>> second ]
- { memory>struct x>> <direct-int-array> <tuple> <tuple-boa> } inlined?
+ { memory>struct x>> int <c-direct-array> <tuple> <tuple-boa> } inlined?
] unit-test
[ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
clone-test-struct <struct>
1 >>x char-array{ 9 1 1 } >>y
clone
- [ x>> ] [ y>> >char-array ] bi
+ [ x>> ] [ y>> char >c-array ] bi
] unit-test
[ t 1 char-array{ 9 1 1 } ] [
clone-test-struct malloc-struct &free
1 >>x char-array{ 9 1 1 } >>y
clone
- [ >c-ptr byte-array? ] [ x>> ] [ y>> >char-array ] tri
+ [ >c-ptr byte-array? ] [ x>> ] [ y>> char >c-array ] tri
] with-destructors
] unit-test
M: struct hashcode*
binary-object over
- [ <direct-uchar-array> hashcode* ] [ 3drop 0 ] if ; inline
+ [ uchar <c-direct-array> hashcode* ] [ 3drop 0 ] if ; inline
: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
PRIVATE>
M: struct byte-length class "struct-size" word-prop ; foldable
-M: struct binary-zero? binary-object <direct-uchar-array> [ 0 = ] all? ; inline
+M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inline
! class definition
: each-method-in-class ( class quot -- )
[ { uint } [ class_copyMethodList ] with-out-parameters ] dip
over 0 = [ 3drop ] [
- [ <direct-void*-array> ] dip
+ [ void* <c-direct-array> ] dip
[ each ] [ drop (free) ] 2bi
] if ; inline
FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
[ 32.0 ] [
- { 1.0 2.0 3.0 } >float-array
- { 4.0 5.0 6.0 } >float-array
+ { 1.0 2.0 3.0 } float >c-array
+ { 4.0 5.0 6.0 } float >c-array
ffi_test_23
] unit-test
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax core-foundation kernel assocs
-specialized-arrays math sequences accessors ;
+USING: alien.c-types alien.data alien.syntax core-foundation
+kernel assocs specialized-arrays math sequences accessors ;
IN: core-foundation.dictionaries
SPECIALIZED-ARRAY: void*
: <CFDictionary> ( alist -- dictionary )
[ kCFAllocatorDefault ] dip
- unzip [ >void*-array ] bi@
+ unzip [ void* >c-array ] bi@
[ [ underlying>> ] bi@ ] [ nip length ] 2bi
&: kCFTypeDictionaryKeyCallBacks
&: kCFTypeDictionaryValueCallBacks
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences namespaces make assocs init accessors
+USING: alien alien.c-types alien.data alien.strings alien.syntax
+kernel math sequences namespaces make assocs init accessors
continuations combinators io.encodings.utf8 destructors locals
arrays specialized-arrays classes.struct core-foundation
core-foundation.arrays core-foundation.run-loop
event-stream-callbacks get delete-at ;
:: (master-event-source-callback) ( eventStream info numEvents eventPaths eventFlags eventIds -- )
- eventPaths numEvents <direct-void*-array> [ utf8 alien>string ] { } map-as
- eventFlags numEvents <direct-int-array>
- eventIds numEvents <direct-longlong-array>
+ eventPaths numEvents void* <c-direct-array> [ utf8 alien>string ] { } map-as
+ eventFlags numEvents int <c-direct-array>
+ eventIds numEvents longlong <c-direct-array>
3array flip
info event-stream-callbacks get at [ drop ] or call( changes -- ) ;
] 2map flip [
f f
] [
- first2 [ >void*-array ] [ >uint-array ] bi*
+ first2 [ void* >c-array ] [ uint >c-array ] bi*
] if-empty ;
: param-formats ( statement -- seq )
GUID_SysMouse device-for-guid
[ configure-mouse ] [ +mouse-device+ set-global ] bi
0 0 0 0 8 f <array> mouse-state boa +mouse-state+ set-global
- MOUSE-BUFFER-SIZE <DIDEVICEOBJECTDATA-array> +mouse-buffer+ set-global ;
+ MOUSE-BUFFER-SIZE DIDEVICEOBJECTDATA <c-array> +mouse-buffer+ set-global ;
: device-info ( device -- DIDEVICEIMAGEINFOW )
DIDEVICEINSTANCEW <struct>
bytes-per-row rowstride =
[ pixels h rowstride * memory>byte-array ]
[
- pixels rowstride h * <direct-uchar-array>
+ pixels rowstride h * uchar <c-direct-array>
rowstride <sliced-groups>
[ bytes-per-row head-slice ] map concat
] if
! Copyright (C) 2009 Doug Coleman, Keith Lazuka
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types byte-arrays combinators fry
-grouping images kernel locals math math.vectors
+USING: accessors alien.c-types alien.data byte-arrays
+combinators fry grouping images kernel locals math math.vectors
sequences specialized-arrays math.floats.half ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: half
[ 255.0 * >integer ] B{ } map-as ;
M: float-components normalize-component-type*
- drop float-array-cast normalize-floats ;
+ drop float cast-array normalize-floats ;
M: half-components normalize-component-type*
- drop half-array-cast normalize-floats ;
+ drop half cast-array normalize-floats ;
: ushorts>ubytes ( bitmap -- bitmap' )
- ushort-array-cast [ -8 shift ] B{ } map-as ; inline
+ ushort cast-array [ -8 shift ] B{ } map-as ; inline
M: ushort-components normalize-component-type*
drop ushorts>ubytes ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types combinators destructors
-io.backend.unix kernel math.bitwise sequences
+USING: accessors alien.c-types alien.data combinators
+destructors io.backend.unix kernel math.bitwise sequences
specialized-arrays unix unix.kqueue unix.time assocs
io.backend.unix.multiplexers classes.struct literals ;
SPECIALIZED-ARRAY: kevent
: <kqueue-mx> ( -- mx )
kqueue-mx new-mx
kqueue dup io-error >>fd
- max-events <kevent-array> >>events ;
+ max-events \ kevent <c-array> >>events ;
M: kqueue-mx dispose* fd>> close-file ;
io.backend io.files io.files.info io.files.unix kernel math system unix
unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd
sequences grouping alien.strings io.encodings.utf8 unix.types
-arrays io.files.info.unix classes.struct
-specialized-arrays ;
+arrays io.files.info.unix classes.struct specialized-arrays
+alien.data ;
SPECIALIZED-ARRAY: statfs
IN: io.files.info.unix.freebsd
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
- <statfs-array>
+ \ statfs <c-array>
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
M: macosx file-systems ( -- array )
f void* <ref> dup 0 getmntinfo64 dup io-error
- [ void* deref ] dip <direct-statfs64-array>
+ [ void* deref ] dip \ statfs64 <c-direct-array>
[ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ;
M: macosx new-file-system-info macosx-file-system-info new ;
combinators system io.backend accessors alien.c-types
io.encodings.utf8 alien.strings unix.types io.files.unix
io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays
-grouping sequences io.encodings.utf8 classes.struct
+grouping sequences io.encodings.utf8 classes.struct alien.data
specialized-arrays io.files.info.unix ;
SPECIALIZED-ARRAY: statvfs
IN: io.files.info.unix.netbsd
M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error
- <statvfs-array>
+ \ statvfs <c-array>
[ dup byte-length 0 getvfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
combinators io.backend io.files io.files.info io.files.unix kernel math
sequences system unix unix.getfsstat.openbsd grouping
unix.statfs.openbsd unix.statvfs.openbsd unix.types
-arrays io.files.info.unix classes.struct
+arrays io.files.info.unix classes.struct alien.data
specialized-arrays io.encodings.utf8 ;
SPECIALIZED-ARRAY: statfs
IN: io.files.unix.openbsd
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
- <statfs-array>
+ \ statfs <c-array>
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays calendar calendar.unix
-classes.struct combinators combinators.short-circuit io.backend
-io.directories io.files.info io.files.types kernel literals
-math math.bitwise sequences specialized-arrays strings system
-unix unix.ffi unix.groups unix.stat unix.time unix.users
-vocabs.loader ;
+USING: accessors alien.c-types alien.data arrays calendar
+calendar.unix classes.struct combinators
+combinators.short-circuit io.backend io.directories
+io.files.info io.files.types kernel literals math math.bitwise
+sequences specialized-arrays strings system unix unix.ffi
+unix.groups unix.stat unix.time unix.users vocabs.loader ;
IN: io.files.info.unix
SPECIALIZED-ARRAY: timeval
: timestamps>byte-array ( timestamps -- byte-array )
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
- >timeval-array ;
+ timeval >c-array ;
PRIVATE>
SetFileTime win32-error=0/f ;
M: windows cwd
- MAX_UNICODE_PATH dup <ushort-array>
+ MAX_UNICODE_PATH dup ushort <c-array>
[ GetCurrentDirectory win32-error=0/f ] keep
utf16n alien>string ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types system kernel unix math sequences
+USING: alien.c-types alien.data system kernel unix math sequences
io.backend.unix io.ports specialized-arrays accessors unix.ffi ;
QUALIFIED: io.pipes
SPECIALIZED-ARRAY: int
IN: io.pipes.unix
M: unix io.pipes:(pipe) ( -- pair )
- 2 <int-array>
+ 2 int <c-array>
[ pipe io-error ]
[ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;
-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 ;
+USING: alien.c-types alien.data destructors io io.directories
+io.encodings.binary io.files io.files.temp kernel libc math
+sequences tools.test ;
IN: io.ports.tests
! Make sure that writing malloced storage to a file works, and
[
100,000 iota
0
- 100,000 malloc-int-array &free [ copy ] keep write
+ 100,000 int malloc-array &free [ copy ] keep write
] with-destructors
] with-file-writer
] unit-test
[ t ] [
"test.txt" temp-file binary [
- 100,000 4 * read int-array-cast 100,000 iota sequence=
+ 100,000 4 * read int cast-array 100,000 iota sequence=
] with-file-reader
] unit-test
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 alien alien.c-types assocs io.encodings.binary summary
-accessors destructors combinators fry specialized-arrays
+dlists alien alien.c-types alien.data assocs io.encodings.binary
+summary accessors destructors combinators fry specialized-arrays
locals ;
SPECIALIZED-ARRAY: uchar
IN: io.ports
buffer>> byte>buffer ; inline
: write-in-groups ( byte-array port -- )
- [ binary-object <direct-uchar-array> ] dip
+ [ binary-object uchar <c-direct-array> ] dip
[ buffer>> size>> <sliced-groups> ] [ '[ _ stream-write ] ] bi
each ;
USING: accessors math math.bitwise tools.test kernel words
-specialized-arrays alien.c-types math.vectors.simd
+specialized-arrays alien.c-types alien.data math.vectors.simd
sequences destructors libc literals classes.struct ;
SPECIALIZED-ARRAY: int
IN: math.bitwise.tests
[ 1 ] [
[
- 2 malloc-int-array &free 1 0 pick set-nth bit-count
+ 2 int malloc-array &free 1 0 pick set-nth bit-count
] with-destructors
] unit-test
] unit-test
[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ]
-[ { 1.0 2.0 3.0 1/0. -1/0. } >half-array ] unit-test
+[ { 1.0 2.0 3.0 1/0. -1/0. } half >c-array ] unit-test
: [byte>rep-array] ( rep -- class )
{
- { char-16-rep [ [ 16 <direct-char-array> ] ] }
- { uchar-16-rep [ [ 16 <direct-uchar-array> ] ] }
- { short-8-rep [ [ 8 <direct-short-array> ] ] }
- { ushort-8-rep [ [ 8 <direct-ushort-array> ] ] }
- { int-4-rep [ [ 4 <direct-int-array> ] ] }
- { uint-4-rep [ [ 4 <direct-uint-array> ] ] }
- { longlong-2-rep [ [ 2 <direct-longlong-array> ] ] }
- { ulonglong-2-rep [ [ 2 <direct-ulonglong-array> ] ] }
- { float-4-rep [ [ 4 <direct-float-array> ] ] }
- { double-2-rep [ [ 2 <direct-double-array> ] ] }
+ { char-16-rep [ [ 16 c:char <c-direct-array> ] ] }
+ { uchar-16-rep [ [ 16 c:uchar <c-direct-array> ] ] }
+ { short-8-rep [ [ 8 c:short <c-direct-array> ] ] }
+ { ushort-8-rep [ [ 8 c:ushort <c-direct-array> ] ] }
+ { int-4-rep [ [ 4 c:int <c-direct-array> ] ] }
+ { uint-4-rep [ [ 4 c:uint <c-direct-array> ] ] }
+ { longlong-2-rep [ [ 2 c:longlong <c-direct-array> ] ] }
+ { ulonglong-2-rep [ [ 2 c:ulonglong <c-direct-array> ] ] }
+ { float-4-rep [ [ 4 c:float <c-direct-array> ] ] }
+ { double-2-rep [ [ 2 c:double <c-direct-array> ] ] }
} case ; foldable
: [>rep-array] ( rep -- class )
{
- { char-16-rep [ [ >char-array ] ] }
- { uchar-16-rep [ [ >uchar-array ] ] }
- { short-8-rep [ [ >short-array ] ] }
- { ushort-8-rep [ [ >ushort-array ] ] }
- { int-4-rep [ [ >int-array ] ] }
- { uint-4-rep [ [ >uint-array ] ] }
- { longlong-2-rep [ [ >longlong-array ] ] }
- { ulonglong-2-rep [ [ >ulonglong-array ] ] }
- { float-4-rep [ [ >float-array ] ] }
- { double-2-rep [ [ >double-array ] ] }
+ { char-16-rep [ [ c:char >c-array ] ] }
+ { uchar-16-rep [ [ c:uchar >c-array ] ] }
+ { short-8-rep [ [ c:short >c-array ] ] }
+ { ushort-8-rep [ [ c:ushort >c-array ] ] }
+ { int-4-rep [ [ c:int >c-array ] ] }
+ { uint-4-rep [ [ c:uint >c-array ] ] }
+ { longlong-2-rep [ [ c:longlong >c-array ] ] }
+ { ulonglong-2-rep [ [ c:ulonglong >c-array ] ] }
+ { float-4-rep [ [ c:float >c-array ] ] }
+ { double-2-rep [ [ c:double >c-array ] ] }
} case ; foldable
: [<rep-array>] ( rep -- class )
{
- { char-16-rep [ [ 16 (char-array) ] ] }
- { uchar-16-rep [ [ 16 (uchar-array) ] ] }
- { short-8-rep [ [ 8 (short-array) ] ] }
- { ushort-8-rep [ [ 8 (ushort-array) ] ] }
- { int-4-rep [ [ 4 (int-array) ] ] }
- { uint-4-rep [ [ 4 (uint-array) ] ] }
- { longlong-2-rep [ [ 2 (longlong-array) ] ] }
- { ulonglong-2-rep [ [ 2 (ulonglong-array) ] ] }
- { float-4-rep [ [ 4 (float-array) ] ] }
- { double-2-rep [ [ 2 (double-array) ] ] }
+ { char-16-rep [ [ 16 c:char (c-array) ] ] }
+ { uchar-16-rep [ [ 16 c:uchar (c-array) ] ] }
+ { short-8-rep [ [ 8 c:short (c-array) ] ] }
+ { ushort-8-rep [ [ 8 c:ushort (c-array) ] ] }
+ { int-4-rep [ [ 4 c:int (c-array) ] ] }
+ { uint-4-rep [ [ 4 c:uint (c-array) ] ] }
+ { longlong-2-rep [ [ 2 c:longlong (c-array) ] ] }
+ { ulonglong-2-rep [ [ 2 c:ulonglong (c-array) ] ] }
+ { float-4-rep [ [ 4 c:float (c-array) ] ] }
+ { double-2-rep [ [ 2 c:double (c-array) ] ] }
} case ; foldable
: rep-tf-values ( rep -- t f )
glActiveTexture swap glBindTexture gl-error ;
: (set-draw-buffers) ( buffers -- )
- [ length ] [ >uint-array ] bi glDrawBuffers ;
+ [ length ] [ uint >c-array ] bi glDrawBuffers ;
MACRO: set-draw-buffers ( buffers -- )
words>values '[ _ (set-draw-buffers) ] ;
: gl-program-shaders ( program -- shaders )
dup gl-program-shaders-length 2 *
0 int <ref>
- over <uint-array>
+ over uint <c-array>
[ glGetAttachedShaders ] keep [ zero? not ] filter ;
: delete-gl-program-only ( program -- )
! See http://factorcode.org/license.txt for BSD license.
! mersenne twister based on
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
-USING: alien.c-types kernel math namespaces sequences
+USING: alien.c-types alien.data kernel math namespaces sequences
sequences.private system init accessors math.ranges random
math.bitwise combinators specialized-arrays fry ;
SPECIALIZED-ARRAY: uint
] each-integer ; inline
: init-mt-seq ( seed -- seq )
- 32 bits n <uint-array>
+ 32 bits n uint <c-array>
[ set-first ] [ init-mt-rest ] [ ] tri ; inline
: mt-temper ( y -- yt )
: <sfmt-array> ( sfmt -- uint-array uint-4-array )
state>>
- [ n>> 4 * [1,b] >uint-array ] [ seed>> ] bi
+ [ n>> 4 * [1,b] uint >c-array ] [ seed>> ] bi
[
[
[ -30 shift ] [ ] bi bitxor
state-multiplier * 32 bits
] dip + 32 bits
] uint-array{ } accumulate-as nip
- dup uint-4-array-cast ;
+ dup uint-4 cast-array ;
: <sfmt-state> ( seed n m mask parity -- sfmt )
sfmt-state <struct>
! Copyright (C) 2009 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel prettyprint.backend
+USING: accessors alien.data kernel prettyprint.backend
prettyprint.sections prettyprint.custom
specialized-arrays ;
IN: specialized-arrays.prettyprint
: pprint-direct-array ( direct-array -- )
- dup direct-array-syntax
- [ [ underlying>> ] [ length>> ] bi [ pprint* ] bi@ ] pprint-prefix ;
+ \ c-array@ [
+ [ underlying-type ] [ underlying>> ] [ length>> ] tri
+ [ pprint* ] tri@
+ ] pprint-prefix ;
M: specialized-array pprint*
[ pprint-object ] [ pprint-direct-array ] pprint-c-object ;
{ { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } }
{ { $snippet "<T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- array )" } } }
{ { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } }
- { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated, zeroed out, unmanaged memory; stack effect " { $snippet "( len -- array )" } } }
{ { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } }
- { { $snippet "T-array-cast" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } }
- { { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
{ { $snippet "T-array{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } }
}
"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-arrays.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-ARRAY: } " or " { $link POSTPONE: SPECIALIZED-ARRAYS: } ". This ensures that the vocabulary can get generated the first time it is needed."
"FUNCTION: void process_data ( int* data, int len ) ;"
"int-array{ 10 20 30 } dup length process_data"
}
-"Literal specialized arrays, as well as specialized arrays created with " { $snippet "<T-array>" } " and " { $snippet ">T-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead."
+"Literal specialized arrays, as well as specialized arrays created with " { $snippet "<T-array>" } " and " { $snippet "T >c-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead."
$nl
"In the following example, it is presumed that the C library holds on to a pointer to the array's data after the " { $snippet "init_with_data()" } " call returns; this is one situation where unmanaged memory has to be used instead. Note the use of destructors to ensure the memory is deallocated after the block ends:"
{ $code
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
-[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
+[ t ] [ { 1 2 3 } int >c-array int-array? ] unit-test
[ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
[ 2 ] [ int-array{ 1 2 3 } second ] unit-test
[ t ] [
- { t f t } >bool-array underlying>>
+ { t f t } bool >c-array underlying>>
{ 1 0 1 } bool heap-size {
- { 1 [ >char-array ] }
- { 4 [ >uint-array ] }
+ { 1 [ char >c-array ] }
+ { 4 [ uint >c-array ] }
} case underlying>> =
] unit-test
[ ushort-array{ 1234 } ] [
- little-endian? B{ 210 4 } B{ 4 210 } ? ushort-array-cast
+ little-endian? B{ 210 4 } B{ 4 210 } ? ushort cast-array
] unit-test
-[ B{ 210 4 1 } ushort-array-cast ] must-fail
+[ B{ 210 4 1 } ushort cast-array ] must-fail
[ { 3 1 3 3 7 } ] [
- int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
+ int-array{ 3 1 3 3 7 } malloc-byte-array 5 int <c-direct-array> >array
] unit-test
[ float-array{ HEX: 1.222,222 HEX: 1.111,112 } ]
! Test prettyprinting
[ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
-[ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
+[ "c-array@ int f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
! If the C type doesn't exist, don't generate a vocab
SYMBOL: __does_not_exist__
INSTANCE: specialized-array sequence
-GENERIC: direct-array-syntax ( obj -- word )
-
-ERROR: bad-byte-array-length byte-array type ;
-
-M: bad-byte-array-length summary
- drop "Byte array length doesn't divide type width" ;
-
-ERROR: not-a-byte-array alien ;
-
-M: not-a-byte-array summary
- drop "Not a byte array" ;
-
: (underlying) ( n c-type -- array )
heap-size * (byte-array) ; inline
: <underlying> ( n type -- array )
heap-size * <byte-array> ; inline
+GENERIC: underlying-type ( c-type -- c-type' )
+
+M: c-type-word underlying-type
+ dup "c-type" word-prop {
+ { [ dup not ] [ drop no-c-type ] }
+ { [ dup pointer? ] [ 2drop void* ] }
+ { [ dup c-type-word? ] [ nip underlying-type ] }
+ [ drop ]
+ } cond ;
+
+M: pointer underlying-type
+ drop void* ;
+
<PRIVATE
GENERIC: nth-c-ptr ( n seq -- displaced-alien )
(A) DEFINES (${A})
<direct-A> DEFINES <direct-${A}>
malloc-A DEFINES malloc-${A}
->A DEFINES >${A}
A-cast DEFINES ${A}-cast
A{ DEFINES ${A}{
A@ DEFINES ${A}@
: (A) ( n -- specialized-array )
[ \ T (underlying) ] keep <direct-A> ; inline
-: malloc-A ( len -- specialized-array )
- [ \ T heap-size calloc ] keep <direct-A> ; inline
-
-: A-cast ( byte-array -- specialized-array )
- binary-object \ T heap-size /mod 0 =
- [ <direct-A> ] [ drop \ T bad-byte-array-length ] if ; inline
-
M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
M: A length length>> ; inline
M: A set-nth-unsafe underlying>> \ T set-alien-element ; inline
-: >A ( seq -- specialized-array ) A new clone-like ;
-
-M: A like drop dup A instance? [ >A ] unless ; inline
+M: A like drop dup A instance? [ \ T >c-array ] unless ; inline
M: A new-sequence drop (A) ; inline
M: A element-size drop \ T heap-size ; inline
-M: A direct-array-syntax drop \ A@ ;
+M: A underlying-type drop \ T ;
M: A pprint-delims drop \ A{ \ } ;
M: A >pprint-sequence ;
-SYNTAX: A{ \ } [ >A ] parse-literal ;
-SYNTAX: A@ scan-object scan-object <direct-A> suffix! ;
+SYNTAX: A{ \ } [ \ T >c-array ] parse-literal ;
INSTANCE: A specialized-array
;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 ] }
- { [ dup pointer? ] [ 2drop void* ] }
- { [ dup c-type-word? ] [ nip underlying-type ] }
- [ drop ]
- } cond ;
-
-M: pointer underlying-type
- drop void* ;
-
: specialized-array-vocab ( c-type -- vocab )
[
"specialized-arrays.instances." %
M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ;
+M: c-type-word c-array-type
+ underlying-type
+ dup [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+M: pointer c-array-type drop void* c-array-type ;
+
+M: c-type-word c-array-type?
+ underlying-type
+ dup [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+M: pointer c-array-type? drop void* c-array-type? ;
+
SYNTAX: SPECIALIZED-ARRAYS:
";" [ parse-c-type define-array-vocab use-vocab ] each-token ;
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.parser assocs
-classes compiler.units functors growable kernel lexer math
-namespaces parser prettyprint.custom sequences
+USING: accessors alien alien.c-types alien.data alien.parser
+assocs classes compiler.units functors growable kernel lexer
+math namespaces parser prettyprint.custom sequences
specialized-arrays specialized-arrays.private strings
vocabs vocabs.loader vocabs.parser vocabs.generated fry make ;
FROM: sequences.private => nth-unsafe ;
V DEFINES-CLASS ${T}-vector
A IS ${T}-array
->A IS >${A}
<A> IS <${A}>
<direct-A> IS <direct-${A}>
M: A like
drop dup A instance? [
- dup V instance? [ [ >c-ptr ] [ length>> ] bi <direct-A> ] [ >A ] if
+ dup V instance? [
+ [ >c-ptr ] [ length>> ] bi <direct-A>
+ ] [ \ T >c-array ] if
] unless ; inline
SYNTAX: V{ \ } [ >V ] parse-literal ;
PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
: get-directory ( word -- str )
- [ MAX_UNICODE_PATH [ <ushort-array> ] keep dupd ] dip
+ [ MAX_UNICODE_PATH [ ushort <c-array> ] keep dupd ] dip
execute win32-error=0/f alien>native-string ; inline
: windows-directory ( -- str )
! (c)2010 Joe Groff bsd license
-USING: alien.strings byte-arrays io.encodings.utf16n kernel
-specialized-arrays system tools.deploy.libraries windows.kernel32
-windows.types ;
+USING: alien.data alien.strings byte-arrays io.encodings.utf16n
+kernel specialized-arrays system tools.deploy.libraries
+windows.kernel32 windows.types ;
FROM: alien.c-types => ushort ;
SPECIALIZED-ARRAY: ushort
IN: tools.deploy.libraries.windows
M: windows find-library-file
f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [
[
- 32768 (ushort-array) [ 32768 GetModuleFileName drop ] keep
+ 32768 ushort (c-array) [ 32768 GetModuleFileName drop ] keep
utf16n alien>string
] [ FreeLibrary drop ] bi
] [ f ] if* ;
: client-area>RECT ( hwnd -- RECT )
RECT <struct>
[ GetClientRect win32-error=0/f ]
- [ >c-ptr POINT-array-cast [ ClientToScreen drop ] with each ]
+ [ >c-ptr POINT cast-array [ ClientToScreen drop ] with each ]
[ nip ] 2tri ;
: hwnd>RECT ( hwnd -- RECT )
]
with-out-parameters
[| type format n-atoms bytes-after atoms |
- atoms n-atoms <direct-ulong-array> >array
+ atoms n-atoms ulong <c-direct-array> >array
atoms XFree
] call ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math math.vectors locals sequences
-specialized-arrays colors arrays combinators
+specialized-arrays colors arrays combinators alien.data
opengl opengl.gl ui.pens ui.pens.caching ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
direction dim v* dim over v- swap
colors length [ iota ] [ 1 - ] bi v/n [ v*n ] with map
swap [ over v+ 2array ] curry map
- concat concat >float-array ;
+ concat concat float >c-array ;
: gradient-colors ( colors -- seq )
[ >rgba-components 4array dup 2array ] map concat concat
- >float-array ;
+ float >c-array ;
M: gradient recompute-pen ( gadget gradient -- )
[ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types colors help.markup help.syntax
-kernel opengl opengl.gl sequences math.vectors ui.gadgets
-ui.pens specialized-arrays ;
+USING: accessors alien.c-types alien.data colors help.markup
+help.syntax kernel opengl opengl.gl sequences math.vectors
+ui.gadgets ui.pens specialized-arrays ;
SPECIALIZED-ARRAY: float
IN: ui.pens.polygon
dup first suffix ;
: <polygon> ( color points -- polygon )
- dup close-path [ [ concat >float-array ] [ length ] bi ] bi@
+ dup close-path [ [ concat float >c-array ] [ length ] bi ] bi@
polygon boa ;
M: polygon draw-boundary
-USING: alien.c-types accessors assocs classes destructors
-functors kernel lexer math parser sequences specialized-arrays
-ui.backend words ;
+USING: alien.c-types alien.data accessors assocs classes
+destructors functors kernel lexer math parser sequences
+specialized-arrays ui.backend words ;
SPECIALIZED-ARRAY: int
IN: ui.pixel-formats
[ drop { } ] if* ;
: >PFA-int-array ( attribute -- int-array )
- [ >PFA ] map concat PERM prepend 0 suffix >int-array ;
+ [ >PFA ] map concat PERM prepend 0 suffix int >c-array ;
;FUNCTOR
: com-wrap ( object wrapper -- wrapped-object )
[ vtbls>> ] [ (malloc-wrapped-object) ] bi
- [ over length <direct-void*-array> 0 swap copy ] keep
+ [ over length void* <c-direct-array> 0 swap copy ] keep
[ +wrapped-objects+ get-global set-at ] keep ;
: make-DIOBJECTDATAFORMAT-array-quot ( struct arr -- quot )
[ nip length ] [ make-DIOBJECTDATAFORMAT-arrays ] 2bi '[
- _ malloc-DIOBJECTDATAFORMAT-array
+ _ DIOBJECTDATAFORMAT malloc-array
[ _ dup byte-length memcpy ]
[ _ [ get >>pguid drop ] 2each ]
[ ] tri
! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax
+USING: alien alien.c-types alien.data alien.strings alien.syntax
classes.struct combinators io.encodings.utf16n io.files
io.pathnames kernel windows.errors windows.com
windows.com.syntax windows.types windows.user32
: shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT
- MAX_UNICODE_PATH <ushort-array>
+ MAX_UNICODE_PATH ushort <c-array>
[ SHGetFolderPath drop ] keep utf16n alien>string ;
: desktop ( -- str )
FUNCTION: UINT DragQueryFileW ( HDROP hDrop, UINT iFile, LPWSTR lpszFile, UINT cch ) ;
ALIAS: DragQueryFile DragQueryFileW
-FUNCTION: BOOL IsUserAnAdmin ( ) ;
\ No newline at end of file
+FUNCTION: BOOL IsUserAnAdmin ( ) ;
-USING: accessors alien.c-types classes.struct combinators\r
-continuations io kernel libc literals locals sequences\r
-specialized-arrays windows.com memoize\r
+USING: accessors alien.c-types alien.data classes.struct\r
+combinators continuations io kernel libc literals locals\r
+sequences specialized-arrays windows.com memoize\r
windows.com.wrapper windows.kernel32 windows.ole32\r
windows.types ;\r
IN: windows.streams\r
\r
:: IStream-write ( stream pv cb out-written -- hresult )\r
[\r
- pv cb <direct-uchar-array> stream stream-write\r
+ pv cb uchar <c-direct-array> stream stream-write\r
out-written [ cb out-written 0 ULONG set-alien-value ] when\r
S_OK\r
] with-hresult ; inline\r
SYMBOL: keysym
: prepare-lookup ( -- )
- buf-size <uint-array> keybuf set
+ buf-size uint <c-array> keybuf set
0 KeySym <ref> keysym set ;
: finish-lookup ( len -- string keysym )
-USING: alien alien.c-types arrays classes.struct
+USING: alien alien.c-types alien.data 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
"test.txt" temp-file binary [
3 4 * read
] with-file-reader
- int-array-cast
+ int cast-array
] unit-test
[ ] [
[ t ] [
"test.txt" temp-file binary file-contents
- pt-array-cast
+ pt cast-array
pt-array-1 rest-slice sequence=
] unit-test
USING: tools.test io.streams.byte-array io.encodings.binary
io.encodings.utf8 io kernel arrays strings namespaces math
-specialized-arrays alien.c-types io.encodings.ascii ;
+specialized-arrays alien.c-types alien.data io.encodings.ascii ;
SPECIALIZED-ARRAY: int
IN: io.streams.byte-array.tests
! Writing specialized arrays to byte writers
[ int-array{ 1 2 3 } ] [
binary [ int-array{ 1 2 3 } write ] with-byte-writer
- int-array-cast
+ int cast-array
] unit-test
USING: tools.test io.files io.files.temp io io.streams.c
io.encodings.ascii strings destructors kernel specialized-arrays
-alien.c-types math ;
+alien.c-types math alien.data ;
SPECIALIZED-ARRAY: int
IN: io.streams.c.tests
"test.txt" temp-file "rb" fopen <c-reader> [
3 4 * read
] with-input-stream
- int-array-cast
+ int cast-array
] unit-test
! Writing strings to binary streams should fail
! (c)Joe Groff bsd license
-USING: alien.data.map fry generalizations kernel locals math.vectors
+USING: alien.data alien.data.map fry generalizations kernel locals math.vectors
math.vectors.conversion math math.vectors.simd math.ranges sequences
specialized-arrays tools.test ;
FROM: alien.c-types => uchar short int float ;
[ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 } ]
[
int-array{ 1 3 5 } [ dup ] data-map( int -- float[2] )
- float-array-cast
+ float cast-array
] unit-test
[
}
] [
3 iota [ float-4-with ] data-map( object -- float-4 )
- float-4-array-cast
+ float-4 cast-array
] unit-test
[
}
] [
12 iota [ float-4-boa ] data-map( object[4] -- float-4 )
- float-4-array-cast
+ float-4 cast-array
] unit-test
[ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 0.0 0.0 } ]
[ ] data-map( object -- float ) ;
[ float-array{ 0.0 0.5 1.0 } ]
-[ 2 data-map-compiler-bug-test float-array-cast ]
+[ 2 data-map-compiler-bug-test float cast-array ]
unit-test
al-context>> alcMakeContextCurrent drop ; inline
: allocate-sources ( audio-engine -- sources )
- voice-count>> dup (uint-array) [ alGenSources ] keep ; inline
+ voice-count>> dup c:uint (c-array) [ alGenSources ] keep ; inline
:: flush-source ( al-source -- )
al-source alSourceStop
audio-engine get-available-source :> al-source
al-source [
- buffer-count dup (uint-array) [ alGenBuffers ] keep :> al-buffers
+ buffer-count dup c:uint (c-array) [ alGenBuffers ] keep :> al-buffers
generator generator-audio-format :> ( channels sample-bits sample-rate )
streaming-audio-clip new-disposable
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
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAYS: c:float c:void* ;
+SPECIALIZED-VECTOR: c:short
IN: audio.vorbis
TUPLE: vorbis-stream < disposable
vorbis-stream buffer>> :> buffer
buffer length -1 shift :> buffer-length
offset -1 shift :> sample-offset
- buffer buffer-length <direct-short-array> sample-offset short-vector boa :> short-buffer
+ buffer buffer-length c:short <c-direct-array> sample-offset short-vector boa :> short-buffer
vorbis-stream info>> channels>> :> #channels
buffer-length sample-offset - #channels /i :> max-len
len max-len min :> len'
- pcm #channels <direct-void*-array> :> channel*s
+ pcm #channels void* <c-direct-array> :> channel*s
len' iota [| sample |
#channels iota [| channel |
- channel channel*s nth len <direct-float-array>
+ channel channel*s nth len c:float <c-direct-array>
sample swap nth
float>short-sample short-buffer push
] each
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
USING: assocs benchmark.reverse-complement byte-arrays fry io
io.encodings.ascii io.files locals kernel math sequences
-sequences.private specialized-arrays strings typed ;
+sequences.private specialized-arrays strings typed alien.data ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:double
IN: benchmark.fasta
TYPED: make-cumulative ( freq -- chars: byte-array floats: double-array )
[ keys >byte-array ]
- [ values >double-array unclip [ + ] accumulate swap suffix ] bi ;
+ [ values c:double >c-array unclip [ + ] accumulate swap suffix ] bi ;
:: select-random ( seed chars floats -- seed elt )
seed random floats [ <= ] with find drop chars nth-unsafe ; inline
! Copyright (C) 2010 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types specialized-arrays kernel math
+USING: alien.c-types alien.data specialized-arrays kernel math
math.functions math.vectors sequences sequences.private
prettyprint words typed locals math.vectors.simd
math.vectors.simd.cords ;
[ swap nth-unsafe ] [ eval4-A' ] bi-curry bi* n*v ; inline
: eval-At-times-u ( u n -- seq )
- [ double-array-cast ] dip [ (eval-At-times-u) ] inner-loop ; inline
+ [ double cast-array ] dip [ (eval-At-times-u) ] inner-loop ; inline
: eval-AtA-times-u ( u n -- seq )
- [ double-array-cast ] dip [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
+ [ double cast-array ] dip [ eval-A-times-u ] [ eval-At-times-u ] bi ; inline
: ones ( n -- seq )
4 /i [ double-4{ 1.0 1.0 1.0 1.0 } ] double-4-array{ } replicate-as ; inline
] times ; inline
TYPED: spectral-norm ( n: fixnum -- norm )
- u/v [ double-array-cast ] bi@ [ v. ] [ norm-sq ] bi /f sqrt ;
+ u/v [ double cast-array ] bi@ [ v. ] [ norm-sq ] bi /f sqrt ;
: spectral-norm-main ( -- )
2000 spectral-norm . ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes.struct combinators.smart fry kernel
-math math.functions math.order math.parser sequences
+USING: accessors alien.data classes.struct combinators.smart
+fry kernel math math.functions math.order math.parser sequences
specialized-arrays io ;
FROM: alien.c-types => float ;
IN: benchmark.struct-arrays
1 + ; inline
: make-points ( len -- points )
- <point-array> dup 0 [ init-point ] reduce drop ; inline
+ point <c-array> dup 0 [ init-point ] reduce drop ; inline
: point-norm ( point -- norm )
[ xyz [ absq ] tri@ ] sum-outputs sqrt ; inline
http.client io io.encodings.ascii io.files io.files.temp kernel
locals math math.matrices math.parser math.vectors opengl
opengl.capabilities opengl.gl opengl.demo-support sequences
-splitting vectors words specialized-arrays ;
+splitting vectors words specialized-arrays alien.data ;
FROM: sequences => change-nth ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
{
[
[ first concat ] [ second concat ] bi
- append >float-array underlying>>
+ append c:float >c-array underlying>>
GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
]
[
- third concat >uint-array underlying>>
+ third concat c:uint >c-array underlying>>
GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
]
[ first length 3 * ]
! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types chipmunk.ffi classes.struct
-game.loop game.worlds kernel literals locals math method-chains
-opengl.gl random sequences specialized-arrays ui
-ui.gadgets.worlds ui.pixel-formats ;
+USING: accessors alien alien.c-types alien.data chipmunk.ffi
+classes.struct game.loop game.worlds kernel literals locals
+math method-chains opengl.gl random sequences specialized-arrays
+ui ui.gadgets.worlds ui.pixel-formats ;
SPECIALIZED-ARRAY: void*
IN: chipmunk.demo
0 0 0 glColor3f
GL_POINTS glBegin
space bodies>>
- [ num>> ] [ arr>> swap <direct-void*-array> ] bi [
+ [ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
cpBody memory>struct p>> [ x>> ] [ y>> ] bi glVertex2f
] each
glEnd
1 0 0 glColor3f
GL_POINTS glBegin
space arbiters>>
- [ num>> ] [ arr>> swap <direct-void*-array> ] bi [
+ [ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
cpArbiter memory>struct
- [ numContacts>> ] [ contacts>> >c-ptr swap <direct-cpContact-array> ] bi [
+ [ numContacts>> ] [ contacts>> >c-ptr swap cpContact <c-direct-array> ] bi [
p>> [ x>> ] [ y>> ] bi glVertex2f
] each
] each
! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.libraries
+USING: accessors alien alien.c-types alien.data alien.libraries
alien.syntax classes.struct combinators combinators.short-circuit
kernel math math.order sequences typed specialized-arrays locals
system ;
FUNCTION: cpVect cpPolyShapeGetVert ( cpShape* shape, int idx ) ;
TYPED: cpPolyShapeValueOnAxis ( poly: cpPolyShape n: cpVect d -- min-dist )
- swap rot [ numVerts>> ] [ tVerts>> swap <direct-cpVect-array> ] bi swap
+ swap rot [ numVerts>> ] [ tVerts>> swap cpVect <c-direct-array> ] bi swap
[ cpvdot ] curry [ min ] reduce swap - ; inline
TYPED: cpPolyShapeContainsVert ( poly: cpPolyShape v: cpVect -- ? )
- swap [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi swap
+ swap [ numVerts>> ] [ tAxes>> swap cpPolyShapeAxis <c-direct-array> ] bi swap
[
[ [ n>> ] dip cpvdot ] [ drop d>> ] 2bi -
] curry [ max ] reduce 0.0 <= ; inline
TYPED: cpPolyShapeContainsVertPartial ( poly: cpPolyShape v: cpVect n: cpVect -- ? )
- rot [ numVerts>> ] [ tAxes>> swap <direct-cpPolyShapeAxis-array> ] bi -rot
+ rot [ numVerts>> ] [ tAxes>> swap cpPolyShapeAxis <c-direct-array> ] bi -rot
[| axis v n |
axis n>> n cpvdot 0.0 < 0
[ 0.0 ]
[
swap
[ numContacts>> ]
- [ contacts>> swap <direct-void*-array> ] bi nth cpContact memory>struct n>>
+ [ contacts>> swap void* <c-direct-array> ] bi nth cpContact memory>struct n>>
]
[
drop swappedColl>> 0 = [ ] [ cpvneg ] if
TYPED: cpArbiterGetPoint ( arb: cpArbiter i -- p: cpVect )
swap
[ numContacts>> ]
- [ contacts>> swap <direct-void*-array> ] bi
+ [ contacts>> swap void* <c-direct-array> ] bi
nth cpContact memory>struct p>> ; inline
! cpCollision.h
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings alien.syntax arrays
-classes.struct fry io.encodings.ascii io.mmap kernel locals math
-math.intervals sequences specialized-arrays strings typed assocs ;
+USING: accessors alien alien.c-types alien.data alien.strings
+alien.syntax arrays classes.struct fry io.encodings.ascii
+io.mmap kernel locals math math.intervals sequences
+specialized-arrays strings typed assocs ;
IN: elf
! FFI data
elf [ e_shoff>> ] [ e_shnum>> ] bi :> ( off num )
off elf >c-ptr <displaced-alien> num
elf 64-bit?
- [ <direct-Elf64_Shdr-array> ]
- [ <direct-Elf32_Shdr-array> ] if ;
+ [ Elf64_Shdr <c-direct-array> ]
+ [ Elf32_Shdr <c-direct-array> ] if ;
TYPED:: elf-program-headers ( elf: Elf32/64_Ehdr -- headers: Elf32/64_Phdr-array )
elf [ e_phoff>> ] [ e_phnum>> ] bi :> ( off num )
off elf >c-ptr <displaced-alien> num
elf 64-bit?
- [ <direct-Elf64_Phdr-array> ]
- [ <direct-Elf32_Phdr-array> ] if ;
+ [ Elf64_Phdr <c-direct-array> ]
+ [ Elf32_Phdr <c-direct-array> ] if ;
TYPED: elf-loadable-segments ( headers: Elf32/64_Phdr-array -- headers: Elf32/64_Phdr-array )
[ p_type>> PT_LOAD = ] filter ;
] filter [ f ] [ first ] if-empty ;
TYPED:: elf-segment-data ( elf: Elf32/64_Ehdr header: Elf32/64_Phdr -- uchar-array/f )
- header [ p_offset>> elf >c-ptr <displaced-alien> ] [ p_filesz>> ] bi <direct-uchar-array> ;
+ header [ p_offset>> elf >c-ptr <displaced-alien> ] [ p_filesz>> ] bi uchar <c-direct-array> ;
TYPED:: elf-section-data ( elf: Elf32/64_Ehdr header: Elf32/64_Shdr -- uchar-array/f )
- header [ sh_offset>> elf >c-ptr <displaced-alien> ] [ sh_size>> ] bi <direct-uchar-array> ;
+ header [ sh_offset>> elf >c-ptr <displaced-alien> ] [ sh_size>> ] bi uchar <c-direct-array> ;
TYPED:: elf-section-data-by-index ( elf: Elf32/64_Ehdr index -- header/f uchar-array/f )
elf elf-section-headers :> sections
elf ".strtab" elf-section-data-by-name nip >c-ptr :> strings
section-data [ >c-ptr ] [ length ] bi
elf 64-bit?
- [ Elf64_Sym heap-size / <direct-Elf64_Sym-array> ]
- [ Elf32_Sym heap-size / <direct-Elf32_Sym-array> ] if
+ [ Elf64_Sym heap-size / Elf64_Sym <c-direct-array> ]
+ [ Elf32_Sym heap-size / Elf32_Sym <c-direct-array> ] if
[ [ st_name>> strings <displaced-alien> ascii alien>string ] keep 2array ] { } map-as ;
! High level interface
symbol [ elf-header>> ] [ sym>> st_value>> ] bi virtual-address-segment :> segment
symbol sym>> st_value>> segment p_vaddr>> - segment p_offset>> + :> faddress
faddress symbol elf-header>> >c-ptr <displaced-alien>
- symbol sym>> st_size>> <direct-uchar-array> ;
+ symbol sym>> st_size>> uchar <c-direct-array> ;
: find-section ( sections name -- section/f )
'[ name>> _ = ] find nip ; inline
images.loader kernel literals locals make math math.rectangles
math.vectors namespaces opengl.gl sequences specialized-arrays
ui.gadgets.worlds ui.gestures ui.pixel-formats gpu.effects.step
-images.pgm images.ppm ;
+images.pgm images.ppm alien.data ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: fluids
fluids-world H{
{ T{ button-down } [ [
- hand-loc get >float-array
- world get dim>> >float-array v/ 2 v*n 1 v-n { 1 -1 } v*
+ hand-loc get float >c-array
+ world get dim>> float >c-array v/ 2 v*n 1 v-n { 1 -1 } v*
float-array{ 0 0.2 } 2.0 particle_t <struct-boa> suffix
] change-particles drop ] }
} set-gestures
! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays circular colors colors.constants
-columns destructors fonts gpu.buffers gpu.render gpu.shaders gpu.state
-gpu.textures images kernel literals locals make math math.constants
-math.functions math.vectors sequences specialized-arrays typed ui.text fry ;
+USING: accessors alien.c-types alien.data arrays circular colors
+colors.constants columns destructors fonts gpu.buffers
+gpu.render gpu.shaders gpu.state gpu.textures images kernel
+literals locals make math math.constants math.functions
+math.vectors sequences specialized-arrays typed ui.text fry ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAYS: float uint ;
IN: game.debug
image upside-down?>>
[ { x0 y0 0 0 x1 y0 1 0 x1 y1 1 1 x0 y1 0 1 } ]
[ { x0 y0 0 1 x1 y0 1 1 x1 y1 1 0 x0 y1 0 0 } ]
- if >float-array ;
+ if float >c-array ;
: debug-text-uniform-variables ( string color -- image uniforms )
text>image dup image>texture
! Copyright (C) 2010 Erik Charlebois
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs grouping hashtables kernel locals
-math math.parser sequences sequences.deep
-specialized-arrays.instances.alien.c-types.float
-specialized-arrays.instances.alien.c-types.uint splitting xml
-xml.data xml.traversal math.order namespaces combinators images
-gpu.shaders io make game.models game.models.util
-io.encodings.ascii game.models.loader ;
+USING: accessors alien.c-types alien.data arrays assocs grouping
+hashtables kernel locals math math.parser sequences sequences.deep
+splitting xml xml.data xml.traversal math.order namespaces
+combinators images gpu.shaders io make game.models game.models.util
+io.encodings.ascii game.models.loader specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAYS: c:float c:uint ;
IN: game.models.collada
SINGLETON: collada-models
]
[
soa>aos
- [ flatten >float-array ]
- [ flatten >uint-array ]
+ [ flatten c:float >c-array ]
+ [ flatten c:uint >c-array ]
bi* collada-vertex-format f model boa
] bi ;
! See http://factorcode.org/license.txt for BSD license.
USING: io io.encodings.ascii math.parser sequences splitting
kernel assocs io.files combinators math.order math namespaces
-arrays sequences.deep accessors
-specialized-arrays.instances.alien.c-types.float
-specialized-arrays.instances.alien.c-types.uint game.models
-game.models.util gpu.shaders images game.models.loader
-prettyprint ;
+arrays sequences.deep accessors alien.c-types alien.data
+game.models game.models.util gpu.shaders images game.models.loader
+prettyprint specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAYS: c:float c:uint ;
IN: game.models.obj
SINGLETON: obj-models
: push-current-model ( -- )
current-model get [
- [ dseq>> flatten >float-array ]
- [ iseq>> flatten >uint-array ]
+ [ dseq>> flatten c:float >c-array ]
+ [ iseq>> flatten c:uint >c-array ]
bi obj-vertex-format current-material get model boa models get push
V{ } V{ } H{ } <indexed-seq> current-model set
] unless-empty ;
M: opengl-3 (clear-integer-color-attachment)
[ GL_COLOR 0 ] dip 4 0 pad-tail
swap {
- { int-type [ >int-array glClearBufferiv ] }
- { uint-type [ >uint-array glClearBufferuiv ] }
+ { int-type [ int >c-array glClearBufferiv ] }
+ { uint-type [ uint >c-array glClearBufferuiv ] }
} case ;
:: (clear-color-attachment) ( type attachment value -- )
M: object >uniform-bool-array [ >c-bool ] int-array{ } map-as ; inline
M: binary-data >uniform-bool-array ; inline
-M: object >uniform-int-array >int-array ; inline
+M: object >uniform-int-array c:int >c-array ; inline
M: binary-data >uniform-int-array ; inline
-M: object >uniform-uint-array >uint-array ; inline
+M: object >uniform-uint-array c:uint >c-array ; inline
M: binary-data >uniform-uint-array ; inline
-M: object >uniform-float-array >float-array ; inline
+M: object >uniform-float-array c:float >c-array ; inline
M: binary-data >uniform-float-array ; inline
M: object >uniform-bvec-array '[ _ head-slice [ >c-bool ] int-array{ } map-as ] map concat ; inline
M:: object >uniform-matrix ( sequence cols rows -- c-array )
sequence flip cols head-slice
- [ rows head-slice >float-array ] { } map-as concat ; inline
+ [ rows head-slice c:float >c-array ] { } map-as concat ; inline
M: binary-data >uniform-matrix 2drop ; inline
M: object >uniform-matrix-array
[ gl-attachment ] with map
dup length 1 =
[ first glDrawBuffer ]
- [ [ length ] [ >int-array ] bi glDrawBuffers ] if ;
+ [ [ length ] [ c:int >c-array ] bi glDrawBuffers ] if ;
: bind-named-output-attachments ( program-instance framebuffer attachments -- )
rot '[ first _ swap output-index ] sort-with values
: get-gl-bools ( enum count -- value )
<byte-array> [ glGetBooleanv ] keep [ c-bool> ] { } map-as ;
: get-gl-ints ( enum count -- value )
- <int-array> [ glGetIntegerv ] keep ;
+ int <c-array> [ glGetIntegerv ] keep ;
: get-gl-floats ( enum count -- value )
- <float-array> [ glGetFloatv ] keep ;
+ c:float <c-array> [ glGetFloatv ] keep ;
: get-gl-rect ( enum -- value )
4 get-gl-ints first4 [ 2array ] 2bi@ <rect> ;
f
gvPluginList &(free) :> ret
size* int deref :> size
- ret size <direct-void*-array> [
+ ret size void* <c-direct-array> [
&(free) ascii alien>string
] { } map-as
] with-destructors ;
IN: grid-meshes.tests
-USING: alien.c-types grid-meshes grid-meshes.private
+USING: alien.c-types alien.data grid-meshes grid-meshes.private
specialized-arrays tools.test ;
SPECIALIZED-ARRAY: float
1.0 0.0 0.5 1.0
1.0 0.0 1.0 1.0
}
-] [ { 2 2 } vertex-array float-array-cast ] unit-test
+] [ { 2 2 } vertex-array float cast-array ] unit-test
! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays byte-arrays combinators
-compression.run-length fry grouping images images.loader
-images.normalization io io.binary io.encodings.8-bit.latin1
-io.encodings.string kernel math math.bitwise sequences
-specialized-arrays summary io.streams.throwing ;
+USING: accessors alien.c-types alien.data arrays byte-arrays
+combinators compression.run-length fry grouping images
+images.loader images.normalization io io.binary
+io.encodings.8-bit.latin1 io.encodings.string kernel math
+math.bitwise sequences specialized-arrays summary
+io.streams.throwing ;
QUALIFIED-WITH: bitstreams b
SPECIALIZED-ARRAYS: uint ushort ;
IN: images.bitmap
{ 24 [ color-index>> ] }
{ 16 [
[
- ! ushort-array-cast
+ ! ushort cast-array
2 group [ le> ] map
! 5 6 5
! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
dup header>> bit-count>> {
{ 16 [
dup bitfields>> '[
- ushort-array-cast _ uncompress-bitfield
+ ushort cast-array _ uncompress-bitfield
] change-color-index
] }
{ 32 [ ] }
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.libraries
+USING: accessors alien alien.c-types alien.data alien.libraries
alien.syntax classes.struct combinators endian io.binary
kernel locals math sequences specialized-arrays
system unix.time unix.types ;
: libusb_set_iso_packet_lengths ( transfer length -- )
[ [ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
- <direct-libusb_iso_packet_descriptor-array>
+ libusb_iso_packet_descriptor <c-direct-array>
] dip [ >>length drop ] curry each ; inline
:: libusb_get_iso_packet_buffer ( transfer packet -- data )
transfer
[ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
- <direct-libusb_iso_packet_descriptor-array> 0
+ libusb_iso_packet_descriptor <c-direct-array> 0
[ length>> + ] reduce
transfer buffer>> <displaced-alien>
] if ;
0 transfer
[ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
- <direct-libusb_iso_packet_descriptor-array> nth
+ libusb_iso_packet_descriptor <c-direct-array> nth
length>> packet *
transfer buffer>> <displaced-alien>
] if ;
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien arrays assocs compiler.units effects
-io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
-llvm.types make namespaces sequences specialized-arrays
-vocabs words ;
-SPECIALIZED-ARRAY: void*
+USING: accessors alien alien.data arrays assocs compiler.units
+effects io.backend io.pathnames kernel llvm.core llvm.jit
+llvm.reader llvm.types make namespaces sequences
+specialized-arrays vocabs words ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:void*
IN: llvm.invoker
! get function name, ret type, param types and names
TUPLE: function name alien return params ;
: params ( llvm-function -- param-list )
- dup LLVMCountParams <void*-array>
+ dup LLVMCountParams c:void* <c-array>
[ LLVMGetParams ] keep >array
[ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
: install-bc ( path -- )
[ normalize-path ] [ file-name ] bi
[ load-into-jit ] keep install-module ;
-
+
<< "alien.llvm" create-vocab drop >>
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays combinators kernel
-llvm.core locals math.parser math multiline namespaces parser
-peg.ebnf sequences sequences.deep specialized-arrays strings
-vocabs words ;
+USING: accessors alien.c-types alien.data arrays combinators
+kernel llvm.core locals math.parser math multiline namespaces
+parser peg.ebnf sequences sequences.deep specialized-arrays
+strings vocabs words ;
SPECIALIZED-ARRAY: void*
IN: llvm.types
swap >>packed? swap >>types ;
M: struct (>tref)*
- [ types>> [ (>tref) ] map >void*-array ]
+ [ types>> [ (>tref) ] map void* >c-array ]
[ types>> length ]
[ packed?>> 1 0 ? ] tri LLVMStructType ;
M: struct clean* types>> [ clean ] each ;
M: struct (tref>)*
over LLVMIsPackedStruct 0 = not >>packed?
- swap dup LLVMCountStructElementTypes <void*-array>
+ swap dup LLVMCountStructElementTypes void* <c-array>
[ LLVMGetStructElementTypes ] keep >array
[ (tref>) ] map >>types ;
M: function (>tref)* {
[ return>> (>tref) ]
- [ params>> [ (>tref) ] map >void*-array ]
+ [ params>> [ (>tref) ] map void* >c-array ]
[ params>> length ]
[ vararg?>> 1 0 ? ]
} cleave LLVMFunctionType ;
M: function (tref>)*
over LLVMIsFunctionVarArg 0 = not >>vararg?
over LLVMGetReturnType (tref>) >>return
- swap dup LLVMCountParamTypes <void*-array>
+ swap dup LLVMCountParamTypes void* <c-array>
[ LLVMGetParamTypes ] keep >array
[ (tref>) ] map >>params ;
! Copyright (C) 2010 Erik Charlebois.
! See http:// factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings alien.syntax
-classes classes.struct combinators combinators.short-circuit
-io.encodings.ascii io.encodings.string kernel literals make
-math sequences specialized-arrays typed fry io.mmap formatting
-locals splitting io.binary arrays ;
+USING: accessors alien alien.c-types alien.data alien.strings
+alien.syntax classes classes.struct combinators
+combinators.short-circuit io.encodings.ascii io.encodings.string
+kernel literals make math sequences specialized-arrays typed
+fry io.mmap formatting locals splitting io.binary arrays ;
FROM: alien.c-types => short ;
IN: macho
} case dup
[ >c-ptr fat_header heap-size swap <displaced-alien> ]
[ nfat_arch>> 4 >be le> ] bi
- <direct-fat_arch-array> [
+ fat_arch <c-direct-array> [
{
[ nip cputype>> 4 >be le> ]
[ nip cpusubtype>> 4 >be le> ]
[ offset>> 4 >be le> swap >c-ptr <displaced-alien> ]
- [ nip size>> 4 >be le> <direct-uchar-array> ]
+ [ nip size>> 4 >be le> uchar <c-direct-array> ]
} 2cleave fat-binary-member boa
] with { } map-as ;
[ nsects>> ]
[ segment_command_64? ]
} cleave
- [ <direct-section_64-array> ]
- [ <direct-section-array> ] if ;
+ [ section_64 <c-direct-array> ]
+ [ section <c-direct-array> ] if ;
: sections-array ( segment-commands -- sections-array )
[
: symbols ( mach-header symtab-command -- symbols string-table )
[ symoff>> swap >c-ptr <displaced-alien> ]
[ nsyms>> swap 64-bit?
- [ <direct-nlist_64-array> ]
- [ <direct-nlist-array> ] if ]
+ [ nlist_64 <c-direct-array> ]
+ [ nlist <c-direct-array> ] if ]
[ stroff>> swap >c-ptr <displaced-alien> ] 2tri ;
: symbol-name ( symbol string-table -- name )
-USING: accessors alien.data.map byte-arrays combinators combinators.short-circuit
+USING: accessors alien.data alien.data.map byte-arrays combinators combinators.short-circuit
fry generalizations images kernel locals math math.constants math.functions
math.libm math.matrices.simd math.vectors math.vectors.conversion math.vectors.simd
memoize random random.mersenne-twister sequences sequences.private specialized-arrays
TYPED:: perlin-noise-map ( table: byte-array transform: matrix4 coords: float-4-array -- map: float-array )
coords [| coord | table transform coord m4.v perlin-noise ] data-map( float-4 -- c:float )
- float-array-cast ;
+ c:float cast-array ;
: perlin-noise-image ( table transform dim -- image )
[ perlin-noise-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ;
DESTRUCTOR: alcDestroyContext
: gen-sources ( size -- seq )
- dup <uint-array> [ alGenSources ] keep ;
+ dup uint <c-array> [ alGenSources ] keep ;
: gen-buffers ( size -- seq )
- dup <uint-array> [ alGenBuffers ] keep ;
+ dup uint <c-array> [ alGenBuffers ] keep ;
: gen-buffer ( -- buffer ) 1 gen-buffers first ;
: queue-buffers ( source buffers -- )
- [ length ] [ >uint-array ] bi alSourceQueueBuffers ;
+ [ length ] [ uint >c-array ] bi alSourceQueueBuffers ;
: queue-buffer ( source buffer -- )
1array queue-buffers ;
:: opencl-square ( in -- out )
0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
- dup <void*-array> [ f clGetPlatformIDs cl-success ] keep first
+ dup void* <c-array> [ f clGetPlatformIDs cl-success ] keep first
CL_DEVICE_TYPE_DEFAULT 1 f void* <ref> [ f clGetDeviceIDs cl-success ] keep void* deref :> device-id
f 1 device-id void* <ref> f f 0 int <ref> [ clCreateContext ] keep int deref cl-success :> context
context device-id 0 0 int <ref> [ clCreateCommandQueue ] keep int deref cl-success :> queue
queue clFinish cl-success
- queue output CL_TRUE 0 in byte-length in length <float-array>
+ queue output CL_TRUE 0 in byte-length in length float <c-array>
[ 0 f f clEnqueueReadBuffer cl-success ] keep
input clReleaseMemObject cl-success
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.libraries alien.syntax
+USING: alien alien.c-types alien.data alien.libraries alien.syntax
classes.struct combinators system alien.accessors byte-arrays
kernel ;
IN: opencl.ffi
{ num-floats } [ ] cl-queue-kernel &dispose drop
cl-finish
- out-buffer 0 num-bytes <cl-buffer-range> cl-read-buffer num-floats <direct-float-array>
+ out-buffer 0 num-bytes <cl-buffer-range>
+ cl-read-buffer num-floats flloat <c-direct-array>
] with-cl-state
] with-destructors ;
[ ascii decode 1 head* ] 2info ; inline
: info-size_t-array ( handle name quot -- size_t-array )
- [ [ length size_t heap-size / ] keep swap <direct-size_t-array> ] info ; inline
+ [ [ length size_t heap-size / ] keep swap size_t <c-direct-array> ] info ; inline
TUPLE: cl-handle < disposable handle ;
PRIVATE>
CL_DEVICE_TYPE_ALL [
0 f 0 uint <ref> [ clGetDeviceIDs cl-success ] keep uint deref
] [
- rot dup <void*-array> [ f clGetDeviceIDs cl-success ] keep
+ rot dup void* <c-array> [ f clGetDeviceIDs cl-success ] keep
] 2bi ; inline
: command-queue-info-ulong ( handle name -- ulong )
: cl-platforms ( -- platforms )
0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
- dup <void*-array> [ f clGetPlatformIDs cl-success ] keep
+ dup void* <c-array> [ f clGetPlatformIDs cl-success ] keep
[
dup
[ platform-info ]
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays kernel random random.cmwc sequences
-specialized-arrays tools.test ;
+USING: alien.c-types alien.data arrays kernel random random.cmwc
+sequences specialized-arrays tools.test ;
SPECIALIZED-ARRAY: uint
IN: random.cmwc.tests
}
] [
cmwc-4096
- 4096 iota >uint-array 362436 <cmwc-seed> seed-random [
+ 4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] unit-test
[ t ] [
cmwc-4096 [
- 4096 iota >uint-array 362436 <cmwc-seed> seed-random [
+ 4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] [
- 4096 iota >uint-array 362436 <cmwc-seed> seed-random [
+ 4096 iota uint >c-array 362436 <cmwc-seed> seed-random [
10 [ random-32 ] replicate
] with-random
] bi =
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays fry kernel locals math
-math.bitwise random sequences sequences.private
+USING: accessors alien.c-types alien.data arrays fry kernel
+locals math math.bitwise random sequences sequences.private
specialized-arrays ;
SPECIALIZED-ARRAY: uint
IN: random.cmwc
swap >>c
swap >>b
swap >>a
- swap [ 1 - >>i ] [ <uint-array> >>Q ] bi
+ swap [ 1 - >>i ] [ uint <c-array> >>Q ] bi
dup b>> 1 - >>r
dup Q>> length 1 - >>mod ; inline
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types fry kernel literals locals math
-random sequences specialized-arrays namespaces sequences.private ;
+USING: accessors alien.c-types alien.data fry kernel literals
+locals math random sequences specialized-arrays namespaces
+sequences.private ;
SPECIALIZED-ARRAY: double
IN: random.lagged-fibonacci
: <lagged-fibonacci> ( seed -- lagged-fibonacci )
lagged-fibonacci new
- p-r 1 + <double-array> >>u
+ p-r 1 + double <c-array> >>u
swap seed-random ; inline
GENERIC: random-float* ( tuple -- r )
VECTOR IS ${TYPE}-blas-vector
<VECTOR> IS <${TYPE}-blas-vector>
->ARRAY IS >${TYPE}-array
XGEMV IS ${T}GEMV
XGEMM IS ${T}GEMM
XGERU IS ${T}GER${U}
drop <VECTOR> ;
: >MATRIX ( arrays -- matrix )
- [ >ARRAY underlying>> ] (>matrix) <MATRIX> ;
+ [ TYPE >c-array underlying>> ] (>matrix) <MATRIX> ;
M: VECTOR n*M.V+n*V!
(prepare-gemv) [ XGEMV ] dip ;
-USING: accessors alien alien.c-types alien.complex arrays ascii
-byte-arrays combinators combinators.short-circuit fry kernel
-math math.blas.ffi math.complex math.functions math.order
-sequences sequences.private functors words locals parser
-prettyprint.backend prettyprint.custom specialized-arrays ;
+USING: accessors alien alien.c-types alien.complex alien.data
+arrays ascii byte-arrays combinators combinators.short-circuit
+fry kernel math math.blas.ffi math.complex math.functions
+math.order sequences sequences.private functors words locals
+parser prettyprint.backend prettyprint.custom specialized-arrays ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double
FUNCTOR: (define-blas-vector) ( TYPE T -- )
<DIRECT-ARRAY> IS <direct-${TYPE}-array>
->ARRAY IS >${TYPE}-array
XCOPY IS ${T}COPY
XSWAP IS ${T}SWAP
IXAMAX IS I${T}AMAX
: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
: >VECTOR ( seq -- v )
- [ >ARRAY underlying>> ] [ length ] bi 1 <VECTOR> ;
+ [ TYPE >c-array underlying>> ] [ length ] bi 1 <VECTOR> ;
M: VECTOR clone
TYPE heap-size (prepare-copy)
projects / factor.git / commitdiff