Specifically,
• Created >c-array to be replacement for >T-array.
• Created cast-array to be generic replacement for all T-array-cast words.
• Created c-array@ to be generic replacement for T-array@ words.
• Replaced usages of <T-array> with T <c-array>
• Replaced usages of <direct-T-array> with T <c-direct-array>
• Replaced usages of >T-array with T >c-array
• Replaced usages of T-array-cast with T cast-array
• Replaced usages of malloc-T-array with T malloc-array.
• Removed malloc-T-array.
• Removed T-array-cast.
• Removed T-array@.
• Removed >T-array.
I also added (but didn't change any code to use):
• T c-array-type, returns T-array
• T c-array?, returns T-array?
• c-array{ T ... }, returns T-array{ ... }
Bootstraps just find on Mac OS X. Also `load-all test-all` works for me.
86 files changed:
vocabs.loader classes.struct quotations kernel ;
IN: alien.data
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>
{ $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: 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." } ;
+
-{ $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 } "." }
{ $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
! (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
QUALIFIED: math
IN: alien.data
GENERIC: c-direct-array-constructor ( c-type -- word ) foldable
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>
GENERIC: <c-array> ( len c-type -- array )
M: word <c-array>
M: pointer <c-direct-array>
drop void* <c-direct-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 )
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
: malloc-byte-array ( byte-array -- alien )
] unless ;
: uint-array-cast-le ( byte-array -- uint-array )
] 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 ;
HINTS: uint-array-cast-le byte-array ;
{ $code "test-struct <struct> ." }
"Creating a new instance with slots initialized from the stack:"
{ $code
{ $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"
"SPECIALIZED-ARRAY: char"
""
"42"
- "\"Hello, chicken.\" >char-array"
+ "\"Hello, chicken.\" char >c-array"
"1024 malloc"
"test-struct <struct-boa> ."
} ;
"1024 malloc"
"test-struct <struct-boa> ."
} ;
[ t ] [
[ struct-test-optimization memory>struct x>> second ]
[ 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
] 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
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 } ] [
] unit-test
[ t 1 char-array{ 9 1 1 } ] [
clone-test-struct malloc-struct &free
1 >>x char-array{ 9 1 1 } >>y
clone
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
] with-destructors
] unit-test
M: struct hashcode*
binary-object over
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
: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
PRIVATE>
M: struct byte-length class "struct-size" 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
: each-method-in-class ( class quot -- )
[ { uint } [ class_copyMethodList ] with-out-parameters ] dip
over 0 = [ 3drop ] [
: 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
[ each ] [ drop (free) ] 2bi
] if ; inline
FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
[ 32.0 ] [
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
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
! 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*
IN: core-foundation.dictionaries
SPECIALIZED-ARRAY: void*
: <CFDictionary> ( alist -- dictionary )
[ kCFAllocatorDefault ] dip
: <CFDictionary> ( alist -- dictionary )
[ kCFAllocatorDefault ] dip
- unzip [ >void*-array ] bi@
+ unzip [ void* >c-array ] bi@
[ [ underlying>> ] bi@ ] [ nip length ] 2bi
&: kCFTypeDictionaryKeyCallBacks
&: kCFTypeDictionaryValueCallBacks
[ [ underlying>> ] bi@ ] [ nip length ] 2bi
&: kCFTypeDictionaryKeyCallBacks
&: kCFTypeDictionaryValueCallBacks
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
! 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
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 -- )
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 -- ) ;
3array flip
info event-stream-callbacks get at [ drop ] or call( changes -- ) ;
- first2 [ >void*-array ] [ >uint-array ] bi*
+ first2 [ void* >c-array ] [ uint >c-array ] bi*
] if-empty ;
: param-formats ( statement -- seq )
] 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
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>
: device-info ( device -- DIDEVICEIMAGEINFOW )
DIDEVICEINSTANCEW <struct>
bytes-per-row rowstride =
[ pixels h rowstride * memory>byte-array ]
[
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
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.
! 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
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*
[ 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*
M: half-components normalize-component-type*
- drop half-array-cast normalize-floats ;
+ drop half cast-array normalize-floats ;
: ushorts>ubytes ( bitmap -- bitmap' )
: 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 ;
M: ushort-components normalize-component-type*
drop ushorts>ubytes ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
! 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
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
: <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 ;
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
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
SPECIALIZED-ARRAY: statfs
IN: io.files.info.unix.freebsd
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
[ 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
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 ;
[ 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
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
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
M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error
[ dup byte-length 0 getvfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
[ 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
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
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
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
[ dup byte-length 0 getfsstat io-error ]
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
[ 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.
! 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
IN: io.files.info.unix
SPECIALIZED-ARRAY: timeval
: timestamps>byte-array ( timestamps -- byte-array )
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
: timestamps>byte-array ( timestamps -- byte-array )
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
SetFileTime win32-error=0/f ;
M: windows cwd
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 ;
[ GetCurrentDirectory win32-error=0/f ] keep
utf16n alien>string ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
! 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 )
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 )
[ pipe io-error ]
[ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;
[ 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
IN: io.ports.tests
! Make sure that writing malloced storage to a file works, and
- 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 [
] 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
] 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
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
locals ;
SPECIALIZED-ARRAY: uchar
IN: io.ports
buffer>> byte>buffer ; inline
: write-in-groups ( byte-array port -- )
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 ;
[ buffer>> size>> <sliced-groups> ] [ '[ _ stream-write ] ] bi
each ;
USING: accessors math math.bitwise tools.test kernel words
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
sequences destructors libc literals classes.struct ;
SPECIALIZED-ARRAY: int
IN: math.bitwise.tests
- 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
] with-destructors
] unit-test
] unit-test
[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ]
] 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 )
{
: [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 )
{
} 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 )
{
} 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 )
} case ; foldable
: rep-tf-values ( rep -- t f )
glActiveTexture swap glBindTexture gl-error ;
: (set-draw-buffers) ( buffers -- )
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) ] ;
MACRO: set-draw-buffers ( buffers -- )
words>values '[ _ (set-draw-buffers) ] ;
: gl-program-shaders ( program -- shaders )
dup gl-program-shaders-length 2 *
0 int <ref>
: gl-program-shaders ( program -- shaders )
dup gl-program-shaders-length 2 *
0 int <ref>
[ glGetAttachedShaders ] keep [ zero? not ] filter ;
: delete-gl-program-only ( program -- )
[ 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
! 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
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 )
] each-integer ; inline
: init-mt-seq ( seed -- seq )
+ 32 bits n uint <c-array>
[ set-first ] [ init-mt-rest ] [ ] tri ; inline
: mt-temper ( y -- yt )
[ set-first ] [ init-mt-rest ] [ ] tri ; inline
: mt-temper ( y -- yt )
: <sfmt-array> ( sfmt -- uint-array uint-4-array )
state>>
: <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
[
[
[ -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>
: <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.
! 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 -- )
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 ;
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 "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 "<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."
{ { $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"
}
"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
$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 ;
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 ] [ 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 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 } ] [
} 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
-[ B{ 210 4 1 } ushort-array-cast ] must-fail
+[ B{ 210 4 1 } ushort cast-array ] must-fail
- 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 } ]
] 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
! 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__
! If the C type doesn't exist, don't generate a vocab
SYMBOL: __does_not_exist__
INSTANCE: specialized-array sequence
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
: (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 )
<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})
<direct-A> DEFINES <direct-${A}>
malloc-A DEFINES malloc-${A}
A-cast DEFINES ${A}-cast
A{ DEFINES ${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
: (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 clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
M: A length length>> ; inline
M: A set-nth-unsafe underlying>> \ T set-alien-element ; 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 new-sequence drop (A) ; inline
M: A element-size drop \ T heap-size ; 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 ;
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
INSTANCE: A specialized-array
-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." %
: specialized-array-vocab ( c-type -- vocab )
[
"specialized-arrays.instances." %
M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ;
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 ;
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.
! 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 ;
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
V DEFINES-CLASS ${T}-vector
A IS ${T}-array
<A> IS <${A}>
<direct-A> IS <direct-${A}>
<A> IS <${A}>
<direct-A> IS <direct-${A}>
M: A like
drop dup A instance? [
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 ;
] unless ; inline
SYNTAX: V{ \ } [ >V ] parse-literal ;
PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
: get-directory ( word -- str )
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 )
execute win32-error=0/f alien>native-string ; inline
: windows-directory ( -- str )
! (c)2010 Joe Groff bsd license
! (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
FROM: alien.c-types => ushort ;
SPECIALIZED-ARRAY: ushort
IN: tools.deploy.libraries.windows
M: windows find-library-file
f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [
[
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* ;
utf16n alien>string
] [ FreeLibrary drop ] bi
] [ f ] if* ;
: client-area>RECT ( hwnd -- RECT )
RECT <struct>
[ GetClientRect win32-error=0/f ]
: 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 )
[ nip ] 2tri ;
: hwnd>RECT ( hwnd -- RECT )
]
with-out-parameters
[| type format n-atoms bytes-after atoms |
]
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
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math math.vectors locals sequences
! 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
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
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
: gradient-colors ( colors -- seq )
[ >rgba-components 4array dup 2array ] map concat concat
M: gradient recompute-pen ( gadget gradient -- )
[ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
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.
! 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
SPECIALIZED-ARRAY: float
IN: ui.pens.polygon
dup first suffix ;
: <polygon> ( color points -- 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
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
SPECIALIZED-ARRAY: int
IN: ui.pixel-formats
[ drop { } ] if* ;
: >PFA-int-array ( attribute -- int-array )
[ 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 ;
: com-wrap ( object wrapper -- wrapped-object )
[ vtbls>> ] [ (malloc-wrapped-object) ] bi
: 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 ;
[ +wrapped-objects+ get-global set-at ] keep ;
: make-DIOBJECTDATAFORMAT-array-quot ( struct arr -- quot )
[ nip length ] [ make-DIOBJECTDATAFORMAT-arrays ] 2bi '[
: 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
[ _ dup byte-length memcpy ]
[ _ [ get >>pguid drop ] 2each ]
[ ] tri
! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
! 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
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
: 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 )
[ SHGetFolderPath drop ] keep utf16n alien>string ;
: desktop ( -- str )
FUNCTION: UINT DragQueryFileW ( HDROP hDrop, UINT iFile, LPWSTR lpszFile, UINT cch ) ;
ALIAS: DragQueryFile DragQueryFileW
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
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
\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
out-written [ cb out-written 0 ULONG set-alien-value ] when\r
S_OK\r
] with-hresult ; inline\r
SYMBOL: keysym
: prepare-lookup ( -- )
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 )
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
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
"test.txt" temp-file binary [
3 4 * read
] with-file-reader
[ t ] [
"test.txt" temp-file binary file-contents
[ t ] [
"test.txt" temp-file binary file-contents
pt-array-1 rest-slice sequence=
] unit-test
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
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
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
! Writing specialized arrays to byte writers
[ int-array{ 1 2 3 } ] [
binary [ int-array{ 1 2 3 } write ] with-byte-writer
USING: tools.test io.files io.files.temp io io.streams.c
io.encodings.ascii strings destructors kernel specialized-arrays
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.data ;
SPECIALIZED-ARRAY: int
IN: io.streams.c.tests
SPECIALIZED-ARRAY: int
IN: io.streams.c.tests
"test.txt" temp-file "rb" fopen <c-reader> [
3 4 * read
] with-input-stream
"test.txt" temp-file "rb" fopen <c-reader> [
3 4 * read
] with-input-stream
] unit-test
! Writing strings to binary streams should fail
] unit-test
! Writing strings to binary streams should fail
! (c)Joe Groff bsd license
! (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 ;
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{ 1.0 1.0 3.0 3.0 5.0 5.0 } ]
[
int-array{ 1 3 5 } [ dup ] data-map( int -- float[2] )
}
] [
3 iota [ float-4-with ] data-map( object -- float-4 )
}
] [
3 iota [ float-4-with ] data-map( object -- float-4 )
}
] [
12 iota [ float-4-boa ] data-map( object[4] -- float-4 )
}
] [
12 iota [ float-4-boa ] data-map( object[4] -- float-4 )
] unit-test
[ float-array{ 1.0 1.0 3.0 3.0 5.0 5.0 0.0 0.0 } ]
] 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 } ]
[ ] 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 ]
al-context>> alcMakeContextCurrent drop ; inline
: allocate-sources ( audio-engine -- sources )
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
:: flush-source ( al-source -- )
al-source alSourceStop
audio-engine get-available-source :> al-source
al-source [
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
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 ;
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
IN: audio.vorbis
TUPLE: vorbis-stream < disposable
vorbis-stream buffer>> :> buffer
buffer length -1 shift :> buffer-length
offset -1 shift :> sample-offset
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'
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 |
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
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
! 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
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 ]
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
:: 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.
! 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 ;
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 )
[ 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 )
: 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
: 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 )
] 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 . ;
: spectral-norm-main ( -- )
2000 spectral-norm . ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
! 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
specialized-arrays io ;
FROM: alien.c-types => float ;
IN: benchmark.struct-arrays
1 + ; inline
: make-points ( len -- points )
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
: 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
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
FROM: sequences => change-nth ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
{
[
[ first concat ] [ second concat ] bi
{
[
[ first concat ] [ second concat ] bi
- append >float-array underlying>>
+ append c:float >c-array underlying>>
GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
]
[
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 * ]
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.
! 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
SPECIALIZED-ARRAY: void*
IN: chipmunk.demo
0 0 0 glColor3f
GL_POINTS glBegin
space bodies>>
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
cpBody memory>struct p>> [ x>> ] [ y>> ] bi glVertex2f
] each
glEnd
1 0 0 glColor3f
GL_POINTS glBegin
space arbiters>>
1 0 0 glColor3f
GL_POINTS glBegin
space arbiters>>
- [ num>> ] [ arr>> swap <direct-void*-array> ] bi [
+ [ num>> ] [ arr>> swap void* <c-direct-array> ] bi [
- [ 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
p>> [ x>> ] [ y>> ] bi glVertex2f
] each
] each
! Copyright (C) 2010 Erik Charlebois
! See http:// factorcode.org/license.txt for BSD license.
! 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 ;
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 )
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 -- ? )
[ 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 -- ? )
[
[ [ 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 ]
[| axis v n |
axis n>> n cpvdot 0.0 < 0
[ 0.0 ]
- [ 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
]
[
drop swappedColl>> 0 = [ ] [ cpvneg ] if
TYPED: cpArbiterGetPoint ( arb: cpArbiter i -- p: cpVect )
swap
[ numContacts>> ]
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
nth cpContact memory>struct p>> ; inline
! cpCollision.h
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
! 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 ;
elf [ e_shoff>> ] [ e_shnum>> ] bi :> ( off num )
off elf >c-ptr <displaced-alien> num
elf 64-bit?
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?
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 ;
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 )
] 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 )
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
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?
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
[ [ 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 [ 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
: 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.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 alien.data ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: fluids
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: fluids
fluids-world H{
{ T{ button-down } [ [
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
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.
! 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
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 } ]
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 } ]
: debug-text-uniform-variables ( string color -- image uniforms )
text>image dup image>texture
: 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.
! 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
IN: game.models.collada
SINGLETON: collada-models
- [ flatten >float-array ]
- [ flatten >uint-array ]
+ [ flatten c:float >c-array ]
+ [ flatten c:uint >c-array ]
bi* collada-vertex-format f model boa
] bi ;
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
! 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
IN: game.models.obj
SINGLETON: obj-models
: push-current-model ( -- )
current-model get [
: 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 ;
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 {
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 -- )
} 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-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: 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: 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: 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
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
M: binary-data >uniform-matrix 2drop ; inline
M: object >uniform-matrix-array
[ gl-attachment ] with map
dup length 1 =
[ first glDrawBuffer ]
[ 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
: 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 )
: 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 )
: 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> ;
: get-gl-rect ( enum -- value )
4 get-gl-ints first4 [ 2array ] 2bi@ <rect> ;
f
gvPluginList &(free) :> ret
size* int deref :> size
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 ;
&(free) ascii alien>string
] { } map-as
] with-destructors ;
-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
specialized-arrays tools.test ;
SPECIALIZED-ARRAY: float
1.0 0.0 0.5 1.0
1.0 0.0 1.0 1.0
}
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.
! 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
QUALIFIED-WITH: bitstreams b
SPECIALIZED-ARRAYS: uint ushort ;
IN: images.bitmap
{ 24 [ color-index>> ] }
{ 16 [
[
{ 24 [ color-index>> ] }
{ 16 [
[
2 group [ le> ] map
! 5 6 5
! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
2 group [ le> ] map
! 5 6 5
! { HEX: f800 HEX: 7e0 HEX: 1f } uncompress-bitfield
dup header>> bit-count>> {
{ 16 [
dup bitfields>> '[
dup header>> bit-count>> {
{ 16 [
dup bitfields>> '[
- ushort-array-cast _ uncompress-bitfield
+ ushort cast-array _ uncompress-bitfield
] change-color-index
] }
{ 32 [ ] }
] change-color-index
] }
{ 32 [ ] }
! Copyright (C) 2010 Erik Charlebois.
! See http://factorcode.org/license.txt for BSD license.
! 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 ;
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
: 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 )
] dip [ >>length drop ] curry each ; inline
:: libusb_get_iso_packet_buffer ( transfer packet -- data )
transfer
[ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
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 ;
[ length>> + ] reduce
transfer buffer>> <displaced-alien>
] if ;
0 transfer
[ iso_packet_desc>> >c-ptr ]
[ num_iso_packets>> ] bi
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 ;
length>> packet *
transfer buffer>> <displaced-alien>
] if ;
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
! 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
IN: llvm.invoker
! get function name, ret type, param types and names
TUPLE: function name alien return params ;
: params ( llvm-function -- param-list )
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 ;
[ LLVMGetParams ] keep >array
[ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
: install-bc ( path -- )
[ normalize-path ] [ file-name ] bi
[ load-into-jit ] keep install-module ;
: install-bc ( path -- )
[ normalize-path ] [ file-name ] bi
[ load-into-jit ] keep install-module ;
<< "alien.llvm" create-vocab drop >>
<< "alien.llvm" create-vocab drop >>
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
! 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
SPECIALIZED-ARRAY: void*
IN: llvm.types
swap >>packed? swap >>types ;
M: struct (>tref)*
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?
[ 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 ;
[ LLVMGetStructElementTypes ] keep >array
[ (tref>) ] map >>types ;
M: function (>tref)* {
[ return>> (>tref) ]
M: function (>tref)* {
[ return>> (>tref) ]
- [ params>> [ (>tref) ] map >void*-array ]
+ [ params>> [ (>tref) ] map void* >c-array ]
[ params>> length ]
[ vararg?>> 1 0 ? ]
} cleave LLVMFunctionType ;
[ params>> length ]
[ vararg?>> 1 0 ? ]
} cleave LLVMFunctionType ;
M: function (tref>)*
over LLVMIsFunctionVarArg 0 = not >>vararg?
over LLVMGetReturnType (tref>) >>return
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 ;
[ LLVMGetParamTypes ] keep >array
[ (tref>) ] map >>params ;
! Copyright (C) 2010 Erik Charlebois.
! See http:// factorcode.org/license.txt for BSD license.
! 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
FROM: alien.c-types => short ;
IN: macho
} case dup
[ >c-ptr fat_header heap-size swap <displaced-alien> ]
[ nfat_arch>> 4 >be le> ] bi
} 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 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 ;
} 2cleave fat-binary-member boa
] with { } map-as ;
[ nsects>> ]
[ segment_command_64? ]
} cleave
[ 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 )
[
: sections-array ( segment-commands -- sections-array )
[
: symbols ( mach-header symtab-command -- symbols string-table )
[ symoff>> swap >c-ptr <displaced-alien> ]
[ nsyms>> swap 64-bit?
: 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 )
[ 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
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 )
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 )
: perlin-noise-image ( table transform dim -- image )
[ perlin-noise-map-coords perlin-noise-map ] [ 5/7. 0.5 float-map>image ] bi ;
: 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 )
DESTRUCTOR: alcDestroyContext
: gen-sources ( size -- seq )
- dup <uint-array> [ alGenSources ] keep ;
+ dup uint <c-array> [ alGenSources ] keep ;
: gen-buffers ( size -- seq )
: 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 -- )
: 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 ;
: queue-buffer ( source buffer -- )
1array queue-buffers ;
:: opencl-square ( in -- out )
0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
:: 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
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 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
[ 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.
! 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
classes.struct combinators system alien.accessors byte-arrays
kernel ;
IN: opencl.ffi
{ num-floats } [ ] cl-queue-kernel &dispose drop
cl-finish
{ 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 ;
] with-cl-state
] with-destructors ;
[ ascii decode 1 head* ] 2info ; inline
: info-size_t-array ( handle name quot -- size_t-array )
[ 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>
TUPLE: cl-handle < disposable handle ;
PRIVATE>
CL_DEVICE_TYPE_ALL [
0 f 0 uint <ref> [ clGetDeviceIDs cl-success ] keep uint deref
] [
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 )
] 2bi ; inline
: command-queue-info-ulong ( handle name -- ulong )
: cl-platforms ( -- platforms )
0 f 0 uint <ref> [ clGetPlatformIDs cl-success ] keep uint deref
: 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
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
! 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
SPECIALIZED-ARRAY: uint
IN: random.cmwc.tests
- 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 [
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
] [
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 =
10 [ random-32 ] replicate
] with-random
] bi =
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
! 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
specialized-arrays ;
SPECIALIZED-ARRAY: uint
IN: random.cmwc
swap >>c
swap >>b
swap >>a
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
dup b>> 1 - >>r
dup Q>> length 1 - >>mod ; inline
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
! 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
SPECIALIZED-ARRAY: double
IN: random.lagged-fibonacci
: <lagged-fibonacci> ( seed -- lagged-fibonacci )
lagged-fibonacci new
: <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 )
swap seed-random ; inline
GENERIC: random-float* ( tuple -- r )
VECTOR IS ${TYPE}-blas-vector
<VECTOR> IS <${TYPE}-blas-vector>
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}
XGEMV IS ${T}GEMV
XGEMM IS ${T}GEMM
XGERU IS ${T}GER${U}
drop <VECTOR> ;
: >MATRIX ( arrays -- matrix )
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 ;
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
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: double
FUNCTOR: (define-blas-vector) ( TYPE T -- )
<DIRECT-ARRAY> IS <direct-${TYPE}-array>
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
XCOPY IS ${T}COPY
XSWAP IS ${T}SWAP
IXAMAX IS I${T}AMAX
: <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
: >VECTOR ( seq -- v )
: <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)
M: VECTOR clone
TYPE heap-size (prepare-copy)
projects / factor.git / commitdiff