Merge branch 'master' of git://factorcode.org/git/factor
commit
bda5963c62
|
@ -51,7 +51,7 @@ HELP: c-setter
|
|||
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, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." }
|
||||
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. 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-object>
|
||||
|
@ -73,7 +73,7 @@ HELP: byte-array>memory
|
|||
HELP: malloc-array
|
||||
{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } }
|
||||
{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-direct-array> } "." }
|
||||
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." }
|
||||
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. 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 } "." }
|
||||
{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
|
||||
|
||||
|
@ -132,13 +132,13 @@ HELP: malloc-string
|
|||
|
||||
HELP: require-c-array
|
||||
{ $values { "c-type" "a C type" } }
|
||||
{ $description { $link require } "s any unloaded vocabularies needed to construct a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
|
||||
{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence types loaded." } ;
|
||||
{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
|
||||
{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ;
|
||||
|
||||
HELP: <c-direct-array>
|
||||
{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
|
||||
{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
|
||||
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." } ;
|
||||
{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
|
||||
|
||||
ARTICLE: "c-strings" "C strings"
|
||||
"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
|
||||
|
|
|
@ -21,11 +21,7 @@ TUPLE: abstract-c-type
|
|||
{ getter callable }
|
||||
{ setter callable }
|
||||
size
|
||||
align
|
||||
array-class
|
||||
array-constructor
|
||||
(array)-constructor
|
||||
direct-array-constructor ;
|
||||
align ;
|
||||
|
||||
TUPLE: c-type < abstract-c-type
|
||||
boxer
|
||||
|
@ -75,9 +71,6 @@ M: string c-type ( name -- type )
|
|||
] ?if
|
||||
] if ;
|
||||
|
||||
: ?require-word ( word/pair -- )
|
||||
dup word? [ drop ] [ first require ] ?if ;
|
||||
|
||||
! These words being foldable means that words need to be
|
||||
! recompiled if a C type is redefined. Even so, folding the
|
||||
! size facilitates some optimizations.
|
||||
|
@ -89,55 +82,28 @@ M: abstract-c-type heap-size size>> ;
|
|||
|
||||
GENERIC: require-c-array ( c-type -- )
|
||||
|
||||
M: object require-c-array
|
||||
drop ;
|
||||
M: array require-c-array first require-c-array ;
|
||||
|
||||
M: c-type require-c-array
|
||||
array-class>> ?require-word ;
|
||||
GENERIC: c-array-constructor ( c-type -- word )
|
||||
|
||||
M: string require-c-array
|
||||
c-type require-c-array ;
|
||||
GENERIC: c-(array)-constructor ( c-type -- word )
|
||||
|
||||
M: array require-c-array
|
||||
first c-type require-c-array ;
|
||||
|
||||
ERROR: specialized-array-vocab-not-loaded vocab word ;
|
||||
|
||||
: c-array-constructor ( c-type -- word )
|
||||
array-constructor>> dup array?
|
||||
[ first2 specialized-array-vocab-not-loaded ] when ; foldable
|
||||
|
||||
: c-(array)-constructor ( c-type -- word )
|
||||
(array)-constructor>> dup array?
|
||||
[ first2 specialized-array-vocab-not-loaded ] when ; foldable
|
||||
|
||||
: c-direct-array-constructor ( c-type -- word )
|
||||
direct-array-constructor>> dup array?
|
||||
[ first2 specialized-array-vocab-not-loaded ] when ; foldable
|
||||
GENERIC: c-direct-array-constructor ( c-type -- word )
|
||||
|
||||
GENERIC: <c-array> ( len c-type -- array )
|
||||
M: object <c-array>
|
||||
c-array-constructor execute( len -- array ) ; inline
|
||||
|
||||
M: string <c-array>
|
||||
c-type <c-array> ; inline
|
||||
M: array <c-array>
|
||||
first c-type <c-array> ; inline
|
||||
c-array-constructor execute( len -- array ) ; inline
|
||||
|
||||
GENERIC: (c-array) ( len c-type -- array )
|
||||
M: object (c-array)
|
||||
c-(array)-constructor execute( len -- array ) ; inline
|
||||
|
||||
M: string (c-array)
|
||||
c-type (c-array) ; inline
|
||||
M: array (c-array)
|
||||
first c-type (c-array) ; inline
|
||||
c-(array)-constructor execute( len -- array ) ; inline
|
||||
|
||||
GENERIC: <c-direct-array> ( alien len c-type -- array )
|
||||
M: object <c-direct-array>
|
||||
c-direct-array-constructor execute( alien len -- array ) ; inline
|
||||
|
||||
M: string <c-direct-array>
|
||||
c-type <c-direct-array> ; inline
|
||||
M: array <c-direct-array>
|
||||
first c-type <c-direct-array> ; inline
|
||||
c-direct-array-constructor execute( alien len -- array ) ; inline
|
||||
|
||||
: malloc-array ( n type -- alien )
|
||||
[ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
|
||||
|
@ -347,32 +313,6 @@ M: long-long-type box-return ( type -- )
|
|||
: if-void ( type true false -- )
|
||||
pick "void" = [ drop nip call ] [ nip call ] if ; inline
|
||||
|
||||
: ?lookup ( vocab word -- word/pair )
|
||||
over vocab [ swap lookup ] [ 2array ] if ;
|
||||
|
||||
: set-array-class* ( c-type vocab-stem type-stem -- c-type )
|
||||
{
|
||||
[
|
||||
[ "specialized-arrays." prepend ]
|
||||
[ "-array" append ] bi* ?lookup >>array-class
|
||||
]
|
||||
[
|
||||
[ "specialized-arrays." prepend ]
|
||||
[ "<" "-array>" surround ] bi* ?lookup >>array-constructor
|
||||
]
|
||||
[
|
||||
[ "specialized-arrays." prepend ]
|
||||
[ "(" "-array)" surround ] bi* ?lookup >>(array)-constructor
|
||||
]
|
||||
[
|
||||
[ "specialized-arrays." prepend ]
|
||||
[ "<direct-" "-array>" surround ] bi* ?lookup >>direct-array-constructor
|
||||
]
|
||||
} 2cleave ;
|
||||
|
||||
: set-array-class ( c-type stem -- c-type )
|
||||
dup set-array-class* ;
|
||||
|
||||
CONSTANT: primitive-types
|
||||
{
|
||||
"char" "uchar"
|
||||
|
@ -395,7 +335,6 @@ CONSTANT: primitive-types
|
|||
[ >c-ptr ] >>unboxer-quot
|
||||
"box_alien" >>boxer
|
||||
"alien_offset" >>unboxer
|
||||
"alien" "void*" set-array-class*
|
||||
"void*" define-primitive-type
|
||||
|
||||
<long-long-type>
|
||||
|
@ -407,7 +346,6 @@ CONSTANT: primitive-types
|
|||
8 >>align
|
||||
"box_signed_8" >>boxer
|
||||
"to_signed_8" >>unboxer
|
||||
"longlong" set-array-class
|
||||
"longlong" define-primitive-type
|
||||
|
||||
<long-long-type>
|
||||
|
@ -419,7 +357,6 @@ CONSTANT: primitive-types
|
|||
8 >>align
|
||||
"box_unsigned_8" >>boxer
|
||||
"to_unsigned_8" >>unboxer
|
||||
"ulonglong" set-array-class
|
||||
"ulonglong" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -431,7 +368,6 @@ CONSTANT: primitive-types
|
|||
bootstrap-cell >>align
|
||||
"box_signed_cell" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
"long" set-array-class
|
||||
"long" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -443,7 +379,6 @@ CONSTANT: primitive-types
|
|||
bootstrap-cell >>align
|
||||
"box_unsigned_cell" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
"ulong" set-array-class
|
||||
"ulong" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -455,7 +390,6 @@ CONSTANT: primitive-types
|
|||
4 >>align
|
||||
"box_signed_4" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
"int" set-array-class
|
||||
"int" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -467,7 +401,6 @@ CONSTANT: primitive-types
|
|||
4 >>align
|
||||
"box_unsigned_4" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
"uint" set-array-class
|
||||
"uint" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -479,7 +412,6 @@ CONSTANT: primitive-types
|
|||
2 >>align
|
||||
"box_signed_2" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
"short" set-array-class
|
||||
"short" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -491,7 +423,6 @@ CONSTANT: primitive-types
|
|||
2 >>align
|
||||
"box_unsigned_2" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
"ushort" set-array-class
|
||||
"ushort" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -503,7 +434,6 @@ CONSTANT: primitive-types
|
|||
1 >>align
|
||||
"box_signed_1" >>boxer
|
||||
"to_fixnum" >>unboxer
|
||||
"char" set-array-class
|
||||
"char" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -515,7 +445,6 @@ CONSTANT: primitive-types
|
|||
1 >>align
|
||||
"box_unsigned_1" >>boxer
|
||||
"to_cell" >>unboxer
|
||||
"uchar" set-array-class
|
||||
"uchar" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -525,7 +454,6 @@ CONSTANT: primitive-types
|
|||
1 >>align
|
||||
"box_boolean" >>boxer
|
||||
"to_boolean" >>unboxer
|
||||
"bool" set-array-class
|
||||
"bool" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -539,7 +467,6 @@ CONSTANT: primitive-types
|
|||
"to_float" >>unboxer
|
||||
float-rep >>rep
|
||||
[ >float ] >>unboxer-quot
|
||||
"float" set-array-class
|
||||
"float" define-primitive-type
|
||||
|
||||
<c-type>
|
||||
|
@ -553,7 +480,6 @@ CONSTANT: primitive-types
|
|||
"to_double" >>unboxer
|
||||
double-rep >>rep
|
||||
[ >float ] >>unboxer-quot
|
||||
"double" set-array-class
|
||||
"double" define-primitive-type
|
||||
|
||||
"long" "ptrdiff_t" typedef
|
||||
|
|
|
@ -26,7 +26,6 @@ T-class c-type
|
|||
<T> 1quotation >>unboxer-quot
|
||||
*T 1quotation >>boxer-quot
|
||||
number >>boxed-class
|
||||
T set-array-class
|
||||
drop
|
||||
|
||||
;FUNCTOR
|
||||
|
|
|
@ -66,4 +66,4 @@ M: struct-type stack-size
|
|||
[ name>> = ] with find nip offset>> ;
|
||||
|
||||
USE: vocabs.loader
|
||||
"struct-arrays" require
|
||||
"specialized-arrays" require
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -5,7 +5,8 @@ math.functions math.parser namespaces splitting grouping strings
|
|||
sequences byte-arrays locals sequences.private macros fry
|
||||
io.encodings.binary math.bitwise checksums accessors
|
||||
checksums.common checksums.stream combinators combinators.smart
|
||||
specialized-arrays.uint literals hints ;
|
||||
specialized-arrays literals hints ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
IN: checksums.md5
|
||||
|
||||
SINGLETON: md5
|
||||
|
|
|
@ -5,9 +5,11 @@ classes.struct classes.tuple.private combinators
|
|||
compiler.tree.debugger compiler.units destructors
|
||||
io.encodings.utf8 io.pathnames io.streams.string kernel libc
|
||||
literals math mirrors multiline namespaces prettyprint
|
||||
prettyprint.config see sequences specialized-arrays.char
|
||||
specialized-arrays.int specialized-arrays.ushort
|
||||
struct-arrays system tools.test ;
|
||||
prettyprint.config see sequences specialized-arrays
|
||||
system tools.test ;
|
||||
SPECIALIZED-ARRAY: char
|
||||
SPECIALIZED-ARRAY: int
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: classes.struct.tests
|
||||
|
||||
<<
|
||||
|
@ -301,9 +303,11 @@ STRUCT: struct-test-array-slots
|
|||
STRUCT: struct-test-optimization
|
||||
{ x { "int" 3 } } { y int } ;
|
||||
|
||||
SPECIALIZED-ARRAY: struct-test-optimization
|
||||
|
||||
[ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
|
||||
[ t ] [
|
||||
[ 3 struct-test-optimization <direct-struct-array> third y>> ]
|
||||
[ 3 <direct-struct-test-optimization-array> third y>> ]
|
||||
{ <tuple> <tuple-boa> memory>struct y>> } inlined?
|
||||
] unit-test
|
||||
|
||||
|
|
|
@ -4,13 +4,14 @@ alien.structs.fields arrays byte-arrays classes classes.parser
|
|||
classes.tuple classes.tuple.parser classes.tuple.private
|
||||
combinators combinators.short-circuit combinators.smart
|
||||
definitions functors.backend fry generalizations generic.parser
|
||||
kernel kernel.private lexer libc locals macros make math math.order
|
||||
parser quotations sequences slots slots.private struct-arrays vectors
|
||||
words compiler.tree.propagation.transforms specialized-arrays.uchar ;
|
||||
kernel kernel.private lexer libc locals macros make math
|
||||
math.order parser quotations sequences slots slots.private
|
||||
specialized-arrays vectors words
|
||||
compiler.tree.propagation.transforms ;
|
||||
FROM: slots => reader-word writer-word ;
|
||||
IN: classes.struct
|
||||
|
||||
! struct class
|
||||
SPECIALIZED-ARRAY: uchar
|
||||
|
||||
ERROR: struct-must-have-slots ;
|
||||
|
||||
|
|
|
@ -5,9 +5,11 @@ classes.struct continuations combinators compiler compiler.alien
|
|||
stack-checker kernel math namespaces make quotations sequences
|
||||
strings words cocoa.runtime io macros memoize io.encodings.utf8
|
||||
effects libc libc.private lexer init core-foundation fry
|
||||
generalizations specialized-arrays.alien ;
|
||||
generalizations specialized-arrays ;
|
||||
IN: cocoa.messages
|
||||
|
||||
SPECIALIZED-ARRAY: void*
|
||||
|
||||
: make-sender ( method function -- quot )
|
||||
[ over first , f , , second , \ alien-invoke , ] [ ] make ;
|
||||
|
||||
|
|
|
@ -3,8 +3,10 @@ alien.syntax arrays classes.struct combinators
|
|||
compiler continuations effects io io.backend io.pathnames
|
||||
io.streams.string kernel math memory namespaces
|
||||
namespaces.private parser quotations sequences
|
||||
specialized-arrays.float stack-checker stack-checker.errors
|
||||
system threads tools.test words specialized-arrays.char ;
|
||||
specialized-arrays stack-checker stack-checker.errors
|
||||
system threads tools.test words ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
SPECIALIZED-ARRAY: char
|
||||
IN: compiler.tests.alien
|
||||
|
||||
<<
|
||||
|
|
|
@ -8,8 +8,9 @@ math.functions math.private strings layouts
|
|||
compiler.tree.propagation.info compiler.tree.def-use
|
||||
compiler.tree.debugger compiler.tree.checker
|
||||
slots.private words hashtables classes assocs locals
|
||||
specialized-arrays.double system sorting math.libm
|
||||
specialized-arrays system sorting math.libm
|
||||
math.intervals quotations effects alien ;
|
||||
SPECIALIZED-ARRAY: double
|
||||
IN: compiler.tree.propagation.tests
|
||||
|
||||
[ V{ } ] [ [ ] final-classes ] unit-test
|
||||
|
|
|
@ -1,9 +1,11 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax core-foundation kernel assocs
|
||||
specialized-arrays.alien math sequences accessors ;
|
||||
specialized-arrays math sequences accessors ;
|
||||
IN: core-foundation.dictionaries
|
||||
|
||||
SPECIALIZED-ARRAY: void*
|
||||
|
||||
TYPEDEF: void* CFDictionaryRef
|
||||
TYPEDEF: void* CFMutableDictionaryRef
|
||||
TYPEDEF: void* CFDictionaryKeyCallBacks*
|
||||
|
|
|
@ -3,12 +3,15 @@
|
|||
USING: alien alien.c-types alien.strings alien.syntax kernel
|
||||
math sequences namespaces make assocs init accessors
|
||||
continuations combinators io.encodings.utf8 destructors locals
|
||||
arrays specialized-arrays.alien classes.struct
|
||||
specialized-arrays.int specialized-arrays.longlong
|
||||
core-foundation core-foundation.run-loop core-foundation.strings
|
||||
arrays specialized-arrays classes.struct core-foundation
|
||||
core-foundation.run-loop core-foundation.strings
|
||||
core-foundation.time ;
|
||||
IN: core-foundation.fsevents
|
||||
|
||||
SPECIALIZED-ARRAY: void*
|
||||
SPECIALIZED-ARRAY: int
|
||||
SPECIALIZED-ARRAY: longlong
|
||||
|
||||
CONSTANT: kFSEventStreamCreateFlagUseCFTypes 2
|
||||
CONSTANT: kFSEventStreamCreateFlagWatchRoot 4
|
||||
|
||||
|
|
|
@ -6,7 +6,9 @@ db.types tools.walker ascii splitting math.parser combinators
|
|||
libc calendar.format byte-arrays destructors prettyprint
|
||||
accessors strings serialize io.encodings.binary io.encodings.utf8
|
||||
alien.strings io.streams.byte-array summary present urls
|
||||
specialized-arrays.uint specialized-arrays.alien db.private ;
|
||||
specialized-arrays db.private ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
SPECIALIZED-ARRAY: void*
|
||||
IN: db.postgresql.lib
|
||||
|
||||
: postgresql-result-error-message ( res -- str/f )
|
||||
|
|
|
@ -3,11 +3,13 @@ assocs byte-arrays combinators continuations game-input
|
|||
game-input.dinput.keys-array io.encodings.utf16
|
||||
io.encodings.utf16n kernel locals math math.bitwise
|
||||
math.rectangles namespaces parser sequences shuffle
|
||||
struct-arrays ui.backend.windows vectors windows.com
|
||||
specialized-arrays ui.backend.windows vectors windows.com
|
||||
windows.dinput windows.dinput.constants windows.errors
|
||||
windows.kernel32 windows.messages windows.ole32
|
||||
windows.user32 classes.struct ;
|
||||
SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
|
||||
IN: game-input.dinput
|
||||
|
||||
CONSTANT: MOUSE-BUFFER-SIZE 16
|
||||
|
||||
SINGLETON: dinput-game-input-backend
|
||||
|
@ -70,12 +72,9 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
|
|||
|
||||
: find-mouse ( -- )
|
||||
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 <struct-array>
|
||||
+mouse-buffer+ set-global ;
|
||||
[ 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 ;
|
||||
|
||||
: device-info ( device -- DIDEVICEIMAGEINFOW )
|
||||
DIDEVICEINSTANCEW <struct>
|
||||
|
|
|
@ -5,8 +5,10 @@ combinators compression.run-length endian fry grouping images
|
|||
images.bitmap.loading images.loader io io.binary
|
||||
io.encodings.binary io.encodings.string io.files
|
||||
io.streams.limited kernel locals macros math math.bitwise
|
||||
math.functions namespaces sequences specialized-arrays.uint
|
||||
specialized-arrays.ushort strings summary ;
|
||||
math.functions namespaces sequences specialized-arrays
|
||||
strings summary ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: images.bitmap
|
||||
|
||||
: write2 ( n -- ) 2 >le write ;
|
||||
|
|
|
@ -4,8 +4,9 @@ USING: accessors arrays byte-arrays combinators
|
|||
compression.run-length fry grouping images images.loader io
|
||||
io.binary io.encodings.8-bit io.encodings.binary
|
||||
io.encodings.string io.streams.limited kernel math math.bitwise
|
||||
sequences specialized-arrays.ushort summary ;
|
||||
sequences specialized-arrays summary ;
|
||||
QUALIFIED-WITH: bitstreams b
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: images.bitmap.loading
|
||||
|
||||
SINGLETON: bitmap-image
|
||||
|
|
|
@ -5,8 +5,9 @@ compression.lzw endian fry grouping images io
|
|||
io.binary io.encodings.ascii io.encodings.binary
|
||||
io.encodings.string io.encodings.utf8 io.files kernel math
|
||||
math.bitwise math.order math.parser pack prettyprint sequences
|
||||
strings math.vectors specialized-arrays.float locals
|
||||
strings math.vectors specialized-arrays locals
|
||||
images.loader ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
IN: images.tiff
|
||||
|
||||
SINGLETON: tiff-image
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors classes.struct kernel destructors bit-arrays
|
||||
sequences assocs struct-arrays math namespaces locals fry unix
|
||||
unix.linux.epoll unix.time io.ports io.backend.unix
|
||||
io.backend.unix.multiplexers ;
|
||||
sequences assocs specialized-arrays math namespaces
|
||||
locals fry unix unix.linux.epoll unix.time io.ports
|
||||
io.backend.unix io.backend.unix.multiplexers ;
|
||||
SPECIALIZED-ARRAY: epoll-event
|
||||
IN: io.backend.unix.multiplexers.epoll
|
||||
|
||||
TUPLE: epoll-mx < mx events ;
|
||||
|
@ -16,7 +17,7 @@ TUPLE: epoll-mx < mx events ;
|
|||
: <epoll-mx> ( -- mx )
|
||||
epoll-mx new-mx
|
||||
max-events epoll_create dup io-error >>fd
|
||||
max-events epoll-event <struct-array> >>events ;
|
||||
max-events <epoll-event-array> >>events ;
|
||||
|
||||
M: epoll-mx dispose* fd>> close-file ;
|
||||
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
! 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 struct-arrays unix
|
||||
unix.kqueue unix.time assocs io.backend.unix.multiplexers
|
||||
classes.struct ;
|
||||
io.backend.unix kernel math.bitwise sequences
|
||||
specialized-arrays unix unix.kqueue unix.time assocs
|
||||
io.backend.unix.multiplexers classes.struct ;
|
||||
SPECIALIZED-ARRAY: kevent
|
||||
IN: io.backend.unix.multiplexers.kqueue
|
||||
|
||||
TUPLE: kqueue-mx < mx events ;
|
||||
|
@ -15,7 +16,7 @@ CONSTANT: max-events 256
|
|||
: <kqueue-mx> ( -- mx )
|
||||
kqueue-mx new-mx
|
||||
kqueue dup io-error >>fd
|
||||
max-events \ kevent <struct-array> >>events ;
|
||||
max-events <kevent-array> >>events ;
|
||||
|
||||
M: kqueue-mx dispose* fd>> close-file ;
|
||||
|
||||
|
|
|
@ -4,7 +4,9 @@ USING: accessors alien.c-types alien.syntax combinators
|
|||
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 struct-arrays ;
|
||||
arrays io.files.info.unix classes.struct
|
||||
specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: statfs
|
||||
IN: io.files.info.unix.freebsd
|
||||
|
||||
TUPLE: freebsd-file-system-info < unix-file-system-info
|
||||
|
@ -50,6 +52,6 @@ M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
|
|||
|
||||
M: freebsd file-systems ( -- array )
|
||||
f 0 0 getfsstat dup io-error
|
||||
\ statfs <struct-array>
|
||||
<statfs-array>
|
||||
[ dup byte-length 0 getfsstat io-error ]
|
||||
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
|
||||
|
|
|
@ -1,10 +1,12 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types alien.strings combinators
|
||||
grouping io.encodings.utf8 io.files kernel math sequences
|
||||
system unix io.files.unix specialized-arrays.uint arrays
|
||||
unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx
|
||||
io.files.info.unix io.files.info classes.struct struct-arrays ;
|
||||
grouping io.encodings.utf8 io.files kernel math sequences system
|
||||
unix io.files.unix arrays unix.statfs.macosx unix.statvfs.macosx
|
||||
unix.getfsstat.macosx io.files.info.unix io.files.info
|
||||
classes.struct specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
SPECIALIZED-ARRAY: statfs64
|
||||
IN: io.files.info.unix.macosx
|
||||
|
||||
TUPLE: macosx-file-system-info < unix-file-system-info
|
||||
|
@ -12,7 +14,7 @@ io-size owner type-id filesystem-subtype ;
|
|||
|
||||
M: macosx file-systems ( -- array )
|
||||
f <void*> dup 0 getmntinfo64 dup io-error
|
||||
[ *void* ] dip \ statfs64 <direct-struct-array>
|
||||
[ *void* ] dip <direct-statfs64-array>
|
||||
[ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ;
|
||||
|
||||
M: macosx new-file-system-info macosx-file-system-info new ;
|
||||
|
|
|
@ -4,8 +4,9 @@ USING: alien.syntax kernel unix.stat math unix
|
|||
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 struct-arrays
|
||||
io.files.info.unix ;
|
||||
grouping sequences io.encodings.utf8 classes.struct
|
||||
specialized-arrays io.files.info.unix ;
|
||||
SPECIALIZED-ARRAY: statvfs
|
||||
IN: io.files.info.unix.netbsd
|
||||
|
||||
TUPLE: netbsd-file-system-info < unix-file-system-info
|
||||
|
@ -47,6 +48,6 @@ M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-inf
|
|||
|
||||
M: netbsd file-systems ( -- array )
|
||||
f 0 0 getvfsstat dup io-error
|
||||
\ statvfs <struct-array>
|
||||
<statvfs-array>
|
||||
[ dup byte-length 0 getvfsstat io-error ]
|
||||
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
|
||||
|
|
|
@ -4,8 +4,9 @@ USING: accessors alien.c-types alien.strings alien.syntax
|
|||
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 struct-arrays
|
||||
io.encodings.utf8 ;
|
||||
arrays io.files.info.unix classes.struct
|
||||
specialized-arrays io.encodings.utf8 ;
|
||||
SPECIALIZED-ARRAY: statvfs
|
||||
IN: io.files.unix.openbsd
|
||||
|
||||
TUPLE: openbsd-file-system-info < unix-file-system-info
|
||||
|
@ -48,6 +49,6 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
|
|||
|
||||
M: openbsd file-systems ( -- seq )
|
||||
f 0 0 getfsstat dup io-error
|
||||
\ statfs <struct-array>
|
||||
<statfs-array>
|
||||
[ dup byte-length 0 getfsstat io-error ]
|
||||
[ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
|
||||
|
|
|
@ -3,8 +3,10 @@
|
|||
USING: accessors kernel system math math.bitwise strings arrays
|
||||
sequences combinators combinators.short-circuit alien.c-types
|
||||
vocabs.loader calendar calendar.unix io.files.info
|
||||
io.files.types io.backend io.directories unix unix.stat unix.time unix.users
|
||||
unix.groups classes.struct struct-arrays ;
|
||||
io.files.types io.backend io.directories unix unix.stat
|
||||
unix.time unix.users unix.groups classes.struct
|
||||
specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: timeval
|
||||
IN: io.files.info.unix
|
||||
|
||||
TUPLE: unix-file-system-info < file-system-info
|
||||
|
@ -184,7 +186,7 @@ M: unix copy-file-and-info ( from to -- )
|
|||
|
||||
: timestamps>byte-array ( timestamps -- byte-array )
|
||||
[ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
|
||||
\ timeval >struct-array ;
|
||||
>timeval-array ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
@ -6,7 +6,8 @@ windows.time windows accessors alien.c-types combinators
|
|||
generalizations system alien.strings io.encodings.utf16n
|
||||
sequences splitting windows.errors fry continuations destructors
|
||||
calendar ascii combinators.short-circuit locals classes.struct
|
||||
specialized-arrays.ushort ;
|
||||
specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: io.files.info.windows
|
||||
|
||||
:: round-up-to ( n multiple -- n' )
|
||||
|
|
|
@ -5,7 +5,8 @@ windows.kernel32 kernel libc math threads system environment
|
|||
alien.c-types alien.arrays alien.strings sequences combinators
|
||||
combinators.short-circuit ascii splitting alien strings assocs
|
||||
namespaces make accessors tr windows.time windows.shell32
|
||||
windows.errors specialized-arrays.ushort classes.struct ;
|
||||
windows.errors specialized-arrays classes.struct ;
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: io.files.windows.nt
|
||||
|
||||
M: winnt cwd
|
||||
|
|
|
@ -1,13 +1,13 @@
|
|||
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types arrays continuations io
|
||||
io.backend.windows io.pipes.windows.nt io.pathnames libc io.ports
|
||||
windows.types math windows.kernel32
|
||||
namespaces make io.launcher kernel sequences windows.errors
|
||||
splitting system threads init strings combinators
|
||||
io.backend accessors concurrency.flags io.files assocs
|
||||
io.files.private windows destructors specialized-arrays.ushort
|
||||
specialized-arrays.alien classes classes.struct ;
|
||||
io.backend.windows io.pipes.windows.nt io.pathnames libc
|
||||
io.ports windows.types math windows.kernel32 namespaces make
|
||||
io.launcher kernel sequences windows.errors splitting system
|
||||
threads init strings combinators io.backend accessors
|
||||
concurrency.flags io.files assocs io.files.private windows
|
||||
destructors specialized-arrays.alien classes classes.struct ;
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
IN: io.launcher.windows
|
||||
|
||||
TUPLE: CreateProcess-args
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.alien ;
|
||||
IN: io.mmap.alien
|
||||
|
||||
<< "void*" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.bool ;
|
||||
IN: io.mmap.bool
|
||||
|
||||
<< "bool" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.char ;
|
||||
IN: io.mmap.char
|
||||
|
||||
<< "char" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.double ;
|
||||
IN: io.mmap.double
|
||||
|
||||
<< "double" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.float ;
|
||||
IN: io.mmap.float
|
||||
|
||||
<< "float" define-mapped-array >>
|
|
@ -1,32 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.mmap functors accessors alien.c-types math kernel
|
||||
words fry ;
|
||||
IN: io.mmap.functor
|
||||
|
||||
SLOT: address
|
||||
SLOT: length
|
||||
|
||||
: mapped-file>direct ( mapped-file type -- alien length )
|
||||
[ [ address>> ] [ length>> ] bi ] dip
|
||||
heap-size [ 1 - + ] keep /i ;
|
||||
|
||||
FUNCTOR: define-mapped-array ( T -- )
|
||||
|
||||
<mapped-A> DEFINES <mapped-${T}-array>
|
||||
<A> IS <direct-${T}-array>
|
||||
with-mapped-A-file DEFINES with-mapped-${T}-file
|
||||
with-mapped-A-file-reader DEFINES with-mapped-${T}-file-reader
|
||||
|
||||
WHERE
|
||||
|
||||
: <mapped-A> ( mapped-file -- direct-array )
|
||||
T mapped-file>direct <A> ; inline
|
||||
|
||||
: with-mapped-A-file ( path quot -- )
|
||||
'[ <mapped-A> @ ] with-mapped-file ; inline
|
||||
|
||||
: with-mapped-A-file-reader ( path quot -- )
|
||||
'[ <mapped-A> @ ] with-mapped-file-reader ; inline
|
||||
|
||||
;FUNCTOR
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.int ;
|
||||
IN: io.mmap.int
|
||||
|
||||
<< "int" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.long ;
|
||||
IN: io.mmap.long
|
||||
|
||||
<< "long" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.longlong ;
|
||||
IN: io.mmap.longlong
|
||||
|
||||
<< "longlong" define-mapped-array >>
|
|
@ -1,13 +1,13 @@
|
|||
USING: io io.mmap io.mmap.char io.files io.files.temp
|
||||
USING: io io.mmap io.files io.files.temp
|
||||
io.directories kernel tools.test continuations sequences
|
||||
io.encodings.ascii accessors math ;
|
||||
IN: io.mmap.tests
|
||||
|
||||
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
|
||||
[ ] [ "12345" "mmap-test-file.txt" temp-file ascii set-file-contents ] unit-test
|
||||
[ ] [ "mmap-test-file.txt" temp-file [ CHAR: 2 0 pick set-nth drop ] with-mapped-char-file ] unit-test
|
||||
[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
|
||||
[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file-reader ] unit-test
|
||||
[ ] [ "mmap-test-file.txt" temp-file [ "char" <mapped-array> CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
|
||||
[ 5 ] [ "mmap-test-file.txt" temp-file [ "char" <mapped-array> length ] with-mapped-file ] unit-test
|
||||
[ 5 ] [ "mmap-test-file.txt" temp-file [ "char" <mapped-array> length ] with-mapped-file-reader ] unit-test
|
||||
[ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
|
||||
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: continuations destructors io.files io.files.info
|
||||
io.backend kernel quotations system alien alien.accessors
|
||||
|
@ -30,6 +30,11 @@ PRIVATE>
|
|||
: <mapped-file> ( path -- mmap )
|
||||
[ (mapped-file-r/w) ] prepare-mapped-file ;
|
||||
|
||||
: <mapped-array> ( mmap c-type -- direct-array )
|
||||
[ [ address>> ] [ length>> ] bi ] dip
|
||||
[ heap-size /i ] keep
|
||||
<c-direct-array> ; inline
|
||||
|
||||
HOOK: close-mapped-file io-backend ( mmap -- )
|
||||
|
||||
M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.short ;
|
||||
IN: io.mmap.short
|
||||
|
||||
<< "short" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.uchar ;
|
||||
IN: io.mmap.uchar
|
||||
|
||||
<< "uchar" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.uint ;
|
||||
IN: io.mmap.uint
|
||||
|
||||
<< "uint" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.ulong ;
|
||||
IN: io.mmap.ulong
|
||||
|
||||
<< "ulong" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.ulonglong ;
|
||||
IN: io.mmap.ulonglong
|
||||
|
||||
<< "ulonglong" define-mapped-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.mmap.functor specialized-arrays.ushort ;
|
||||
IN: io.mmap.ushort
|
||||
|
||||
<< "ushort" define-mapped-array >>
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: system kernel unix math sequences
|
||||
io.backend.unix io.ports specialized-arrays.int accessors ;
|
||||
IN: io.pipes.unix
|
||||
io.backend.unix io.ports specialized-arrays accessors ;
|
||||
QUALIFIED: io.pipes
|
||||
SPECIALIZED-ARRAY: int
|
||||
IN: io.pipes.unix
|
||||
|
||||
M: unix io.pipes:(pipe) ( -- pair )
|
||||
2 <int-array>
|
||||
|
|
|
@ -3,9 +3,12 @@ combinators.short-circuit fry kernel locals macros
|
|||
math math.blas.ffi math.blas.vectors math.blas.vectors.private
|
||||
math.complex math.functions math.order functors words
|
||||
sequences sequences.merged sequences.private shuffle
|
||||
specialized-arrays.float specialized-arrays.double
|
||||
specialized-arrays.complex-float specialized-arrays.complex-double
|
||||
parser prettyprint.backend prettyprint.custom ascii ;
|
||||
parser prettyprint.backend prettyprint.custom ascii
|
||||
specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
SPECIALIZED-ARRAY: double
|
||||
SPECIALIZED-ARRAY: complex-float
|
||||
SPECIALIZED-ARRAY: complex-double
|
||||
IN: math.blas.matrices
|
||||
|
||||
TUPLE: blas-matrix-base underlying ld rows cols transpose ;
|
||||
|
|
|
@ -2,8 +2,11 @@ USING: accessors alien alien.c-types 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.float specialized-arrays.double
|
||||
specialized-arrays.complex-float specialized-arrays.complex-double ;
|
||||
specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
SPECIALIZED-ARRAY: double
|
||||
SPECIALIZED-ARRAY: complex-float
|
||||
SPECIALIZED-ARRAY: complex-double
|
||||
IN: math.blas.vectors
|
||||
|
||||
TUPLE: blas-vector-base underlying length inc ;
|
||||
|
|
|
@ -1,8 +1,9 @@
|
|||
IN: math.vectors.simd.alien.tests
|
||||
USING: cpu.architecture math.vectors.simd
|
||||
math.vectors.simd.intrinsics accessors math.vectors.simd.alien
|
||||
kernel classes.struct tools.test compiler sequences byte-arrays
|
||||
alien math kernel.private specialized-arrays.float combinators ;
|
||||
alien math kernel.private specialized-arrays combinators ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
IN: math.vectors.simd.alien.tests
|
||||
|
||||
! Vector alien intrinsics
|
||||
[ float-4{ 1 2 3 4 } ] [
|
||||
|
|
|
@ -1,8 +1,9 @@
|
|||
IN: math.vectors.specialization.tests
|
||||
USING: compiler.tree.debugger math.vectors tools.test kernel
|
||||
kernel.private math specialized-arrays.double
|
||||
specialized-arrays.complex-float
|
||||
specialized-arrays.float ;
|
||||
kernel.private math specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: double
|
||||
SPECIALIZED-ARRAY: complex-float
|
||||
SPECIALIZED-ARRAY: float
|
||||
|
||||
[ V{ t } ] [
|
||||
[ { double-array double-array } declare distance 0.0 < not ] final-literals
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: words kernel make sequences effects kernel.private accessors
|
||||
combinators math math.intervals math.vectors namespaces assocs fry
|
||||
splitting classes.algebra generalizations locals
|
||||
compiler.tree.propagation.info ;
|
||||
USING: alien.c-types words kernel make sequences effects
|
||||
kernel.private accessors combinators math math.intervals
|
||||
math.vectors namespaces assocs fry splitting classes.algebra
|
||||
generalizations locals compiler.tree.propagation.info ;
|
||||
IN: math.vectors.specialization
|
||||
|
||||
SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ;
|
||||
|
@ -99,12 +99,14 @@ M: vector-word subwords specializations values [ word? ] filter ;
|
|||
array-type elt-type word word-schema inputs signature-for-schema ;
|
||||
|
||||
:: specialize-vector-words ( array-type elt-type simd -- )
|
||||
vector-words keys [
|
||||
[ array-type elt-type simd specialize-vector-word ]
|
||||
[ array-type elt-type input-signature ]
|
||||
[ ]
|
||||
tri add-specialization
|
||||
] each ;
|
||||
elt-type number class<= [
|
||||
vector-words keys [
|
||||
[ array-type elt-type simd specialize-vector-word ]
|
||||
[ array-type elt-type input-signature ]
|
||||
[ ]
|
||||
tri add-specialization
|
||||
] each
|
||||
] when ;
|
||||
|
||||
: find-specialization ( classes word -- word/f )
|
||||
specializations
|
||||
|
|
|
@ -7,7 +7,9 @@ continuations kernel libc math macros namespaces math.vectors
|
|||
math.parser opengl.gl combinators combinators.smart arrays
|
||||
sequences splitting words byte-arrays assocs vocabs
|
||||
colors colors.constants accessors generalizations locals fry
|
||||
specialized-arrays.float specialized-arrays.uint ;
|
||||
specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
SPECIALIZED-ARRAY: uint
|
||||
IN: opengl
|
||||
|
||||
: gl-color ( color -- ) >rgba-components glColor4d ; inline
|
||||
|
|
|
@ -2,8 +2,9 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel opengl.gl alien.c-types continuations namespaces
|
||||
assocs alien alien.strings libc opengl math sequences combinators
|
||||
macros arrays io.encodings.ascii fry specialized-arrays.uint
|
||||
macros arrays io.encodings.ascii fry specialized-arrays
|
||||
destructors accessors ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
IN: opengl.shaders
|
||||
|
||||
: with-gl-shader-source-ptr ( string quot -- )
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs cache colors.constants destructors kernel
|
||||
opengl opengl.gl opengl.capabilities combinators images
|
||||
images.tesselation grouping specialized-arrays.float sequences math
|
||||
math.vectors math.matrices generalizations fry arrays namespaces
|
||||
system locals literals ;
|
||||
USING: accessors assocs cache colors.constants destructors
|
||||
kernel opengl opengl.gl opengl.capabilities combinators images
|
||||
images.tesselation grouping sequences math math.vectors
|
||||
math.matrices generalizations fry arrays namespaces system
|
||||
locals literals specialized-arrays ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
IN: opengl.textures
|
||||
|
||||
SYMBOL: non-power-of-2-textures?
|
||||
|
|
|
@ -4,7 +4,8 @@
|
|||
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
|
||||
USING: kernel math namespaces sequences sequences.private system
|
||||
init accessors math.ranges random math.bitwise combinators
|
||||
specialized-arrays.uint fry ;
|
||||
specialized-arrays fry ;
|
||||
SPECIALIZED-ARRAY: uint
|
||||
IN: random.mersenne-twister
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
@ -12,9 +12,9 @@ ABOUT: "sequences.complex"
|
|||
HELP: complex-sequence
|
||||
{ $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." }
|
||||
{ $examples { $example <"
|
||||
USING: prettyprint
|
||||
specialized-arrays.double sequences.complex
|
||||
sequences arrays ;
|
||||
USING: prettyprint specialized-arrays ;
|
||||
sequences.complex sequences arrays ;
|
||||
SPECIALIZED-ARRAY: double
|
||||
double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> >array .
|
||||
"> "{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ;
|
||||
|
||||
|
@ -23,8 +23,9 @@ HELP: <complex-sequence>
|
|||
{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." }
|
||||
{ $examples { $example <"
|
||||
USING: prettyprint
|
||||
specialized-arrays.double sequences.complex
|
||||
specialized-arrays sequences.complex
|
||||
sequences arrays ;
|
||||
SPECIALIZED-ARRAY: double
|
||||
double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> second .
|
||||
"> "C{ -2.0 2.0 }" } } ;
|
||||
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
USING: specialized-arrays.float sequences.complex
|
||||
USING: specialized-arrays sequences.complex
|
||||
kernel sequences tools.test arrays accessors ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
IN: sequences.complex.tests
|
||||
|
||||
: test-array ( -- x )
|
||||
|
|
|
@ -2,9 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: tools.test kernel serialize io io.streams.byte-array
|
||||
alien arrays byte-arrays bit-arrays specialized-arrays.double
|
||||
alien arrays byte-arrays bit-arrays specialized-arrays
|
||||
sequences math prettyprint parser classes math.constants
|
||||
io.encodings.binary random assocs serialize.private ;
|
||||
SPECIALIZED-ARRAY: double
|
||||
IN: serialize.tests
|
||||
|
||||
: test-serialize-cell ( a -- ? )
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.alien
|
||||
|
||||
<< "void*" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.bool
|
||||
|
||||
<< "bool" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.char
|
||||
|
||||
<< "char" define-array >>
|
|
@ -1,13 +0,0 @@
|
|||
USING: kernel sequences specialized-arrays.complex-double tools.test ;
|
||||
IN: specialized-arrays.complex-double.tests
|
||||
|
||||
[ C{ 3.0 2.0 } ]
|
||||
[ complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 } second ] unit-test
|
||||
|
||||
[ C{ 1.0 0.0 } ]
|
||||
[ complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 } first ] unit-test
|
||||
|
||||
[ complex-double-array{ 1.0 C{ 6.0 -7.0 } 5.0 } ] [
|
||||
complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 }
|
||||
dup [ C{ 6.0 -7.0 } 1 ] dip set-nth
|
||||
] unit-test
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.complex-double
|
||||
|
||||
<< "complex-double" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.complex-float
|
||||
|
||||
<< "complex-float" define-array >>
|
|
@ -1,25 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.double
|
||||
|
||||
<< "double" define-array >>
|
||||
|
||||
! Specializer hints. These should really be generalized, and placed
|
||||
! somewhere else
|
||||
USING: hints math.vectors arrays kernel math accessors sequences ;
|
||||
|
||||
HINTS: <double-array> { 2 } { 3 } ;
|
||||
|
||||
HINTS: (double-array) { 2 } { 3 } ;
|
||||
|
||||
! Type functions
|
||||
USING: words classes.algebra compiler.tree.propagation.info
|
||||
math.intervals ;
|
||||
|
||||
\ norm-sq [
|
||||
class>> double-array class<= [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
|
||||
] "outputs" set-word-prop
|
||||
|
||||
\ distance [
|
||||
[ class>> double-array class<= ] both?
|
||||
[ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
|
||||
] "outputs" set-word-prop
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.float
|
||||
|
||||
<< "float" define-array >>
|
|
@ -1,94 +0,0 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: functors sequences sequences.private prettyprint.custom
|
||||
kernel words classes math math.vectors.specialization parser
|
||||
alien.c-types byte-arrays accessors summary alien specialized-arrays ;
|
||||
IN: specialized-arrays.functor
|
||||
|
||||
ERROR: bad-byte-array-length byte-array type ;
|
||||
|
||||
M: bad-byte-array-length summary
|
||||
drop "Byte array length doesn't divide type width" ;
|
||||
|
||||
: (underlying) ( n c-type -- array )
|
||||
heap-size * (byte-array) ; inline
|
||||
|
||||
: <underlying> ( n type -- array )
|
||||
heap-size * <byte-array> ; inline
|
||||
|
||||
FUNCTOR: define-array ( T -- )
|
||||
|
||||
A DEFINES-CLASS ${T}-array
|
||||
S DEFINES-CLASS ${T}-sequence
|
||||
<A> DEFINES <${A}>
|
||||
(A) DEFINES (${A})
|
||||
<direct-A> DEFINES <direct-${A}>
|
||||
>A DEFINES >${A}
|
||||
byte-array>A DEFINES byte-array>${A}
|
||||
|
||||
A{ DEFINES ${A}{
|
||||
A@ DEFINES ${A}@
|
||||
|
||||
NTH [ T dup c-type-getter-boxer array-accessor ]
|
||||
SET-NTH [ T dup c-setter array-accessor ]
|
||||
|
||||
WHERE
|
||||
|
||||
MIXIN: S
|
||||
|
||||
TUPLE: A
|
||||
{ underlying c-ptr read-only }
|
||||
{ length array-capacity read-only } ;
|
||||
|
||||
: <direct-A> ( alien len -- specialized-array ) A boa ; inline
|
||||
|
||||
: <A> ( n -- specialized-array ) [ T <underlying> ] keep <direct-A> ; inline
|
||||
|
||||
: (A) ( n -- specialized-array ) [ T (underlying) ] keep <direct-A> ; inline
|
||||
|
||||
: byte-array>A ( byte-array -- specialized-array )
|
||||
dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
|
||||
<direct-A> ; inline
|
||||
|
||||
M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
|
||||
|
||||
M: A length length>> ; inline
|
||||
|
||||
M: A nth-unsafe underlying>> NTH call ; inline
|
||||
|
||||
M: A set-nth-unsafe underlying>> SET-NTH call ; inline
|
||||
|
||||
: >A ( seq -- specialized-array ) A new clone-like ;
|
||||
|
||||
M: A like drop dup A instance? [ >A ] unless ; inline
|
||||
|
||||
M: A new-sequence drop (A) ; inline
|
||||
|
||||
M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
|
||||
|
||||
M: A resize
|
||||
[
|
||||
[ T heap-size * ] [ underlying>> ] bi*
|
||||
resize-byte-array
|
||||
] [ drop ] 2bi
|
||||
<direct-A> ; inline
|
||||
|
||||
M: A byte-length underlying>> length ; inline
|
||||
M: A pprint-delims drop \ A{ \ } ;
|
||||
M: A >pprint-sequence ;
|
||||
|
||||
SYNTAX: A{ \ } [ >A ] parse-literal ;
|
||||
SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
|
||||
|
||||
INSTANCE: A specialized-array
|
||||
|
||||
A T c-type-boxed-class f specialize-vector-words
|
||||
|
||||
T c-type
|
||||
\ A >>array-class
|
||||
\ <A> >>array-constructor
|
||||
\ (A) >>(array)-constructor
|
||||
\ <direct-A> >>direct-array-constructor
|
||||
drop
|
||||
|
||||
;FUNCTOR
|
|
@ -1 +0,0 @@
|
|||
Code generation for specialized arrays
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.int
|
||||
|
||||
<< "int" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.long
|
||||
|
||||
<< "long" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.longlong
|
||||
|
||||
<< "longlong" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.alien
|
||||
|
||||
<< "ptrdiff_t" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.short
|
||||
|
||||
<< "short" define-array >>
|
|
@ -1,43 +1,52 @@
|
|||
USING: help.markup help.syntax byte-arrays ;
|
||||
USING: help.markup help.syntax byte-arrays alien ;
|
||||
IN: specialized-arrays
|
||||
|
||||
ARTICLE: "specialized-arrays" "Specialized arrays"
|
||||
"The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing."
|
||||
$nl
|
||||
"For each primitive C type " { $snippet "T" } ", a set of words are defined in the vocabulary named " { $snippet "specialized-arrays.T" } ":"
|
||||
HELP: SPECIALIZED-ARRAY:
|
||||
{ $syntax "SPECIALIZED-ARRAY: type" }
|
||||
{ $values { "type" "a C type" } }
|
||||
{ $description "Brings a specialized array for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-array-words" } "." } ;
|
||||
|
||||
ARTICLE: "specialized-array-words" "Specialized array words"
|
||||
"The " { $link POSTPONE: SPECIALIZED-ARRAY: } " parsing word generates the specialized array type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:"
|
||||
{ $table
|
||||
{ { $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 "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( alien 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 unmanaged 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 "byte-array>T-array" } { "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 "}" } } }
|
||||
}
|
||||
"Each specialized array has a " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. This data can be passed to C functions."
|
||||
"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: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
|
||||
|
||||
ARTICLE: "specialized-array-c" "Passing specialized arrays to C functions"
|
||||
"Each specialized array has a " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. Passing a specialized array as a parameter to a C function call will automatically extract the underlying data. To get at the underlying data directly, call the " { $link >c-ptr } " word on a specialized array." ;
|
||||
|
||||
ARTICLE: "specialized-array-math" "Vector arithmetic with specialized arrays"
|
||||
"Each specialized array with a numeric type generates specialized versions of the " { $link "math-vectors" } " words. The compiler substitutes calls for these words if it can statically determine input types. The " { $snippet "optimized." } " word in the " { $vocab-link "compiler.tree.debugger" } " vocabulary can be used to determine if this optimization is being performed for a particular piece of code." ;
|
||||
|
||||
ARTICLE: "specialized-array-examples" "Specialized array examples"
|
||||
"Let's import specialized float arrays:"
|
||||
{ $code "USING: specialized-arrays math.constants math.functions ;" "SPECIALIZED-ARRAY: float" }
|
||||
"Creating a float array with 3 elements:"
|
||||
{ $code "1.0 [ sin ] [ cos ] [ tan ] tri float-array{ } 3sequence ." }
|
||||
"Create a float array and sum the elements:"
|
||||
{ $code
|
||||
"1000 iota [ 1000 /f pi * sin ] float-array{ } map-as"
|
||||
"0.0 [ + ] reduce ."
|
||||
} ;
|
||||
|
||||
ARTICLE: "specialized-arrays" "Specialized arrays"
|
||||
"The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing."
|
||||
$nl
|
||||
"The primitive C types for which specialized arrays exist:"
|
||||
{ $list
|
||||
{ $snippet "char" }
|
||||
{ $snippet "uchar" }
|
||||
{ $snippet "short" }
|
||||
{ $snippet "ushort" }
|
||||
{ $snippet "int" }
|
||||
{ $snippet "uint" }
|
||||
{ $snippet "long" }
|
||||
{ $snippet "ulong" }
|
||||
{ $snippet "longlong" }
|
||||
{ $snippet "ulonglong" }
|
||||
{ $snippet "float" }
|
||||
{ $snippet "double" }
|
||||
{ $snippet "complex-float" }
|
||||
{ $snippet "complex-double" }
|
||||
{ $snippet "void*" }
|
||||
{ $snippet "bool" }
|
||||
}
|
||||
"Note that " { $vocab-link "specialized-arrays.bool" } " behaves like a C " { $snippet "bool[]" } " array, and each element takes up 8 bits of space. For a more space-efficient boolean array, see " { $link "bit-arrays" } "."
|
||||
$nl
|
||||
"Specialized arrays are generated with a functor in the " { $vocab-link "specialized-arrays.functor" } " vocabulary."
|
||||
$nl
|
||||
"The " { $vocab-link "specialized-vectors" } " vocabulary provides resizable versions of the above." ;
|
||||
"A specialized array type needs to be generated for each element type. This is done with a parsing word:"
|
||||
{ $subsection POSTPONE: SPECIALIZED-ARRAY: }
|
||||
"This parsing word adds new words to the search path:"
|
||||
{ $subsection "specialized-array-words" }
|
||||
{ $subsection "specialized-array-c" }
|
||||
{ $subsection "specialized-array-math" }
|
||||
{ $subsection "specialized-array-examples" }
|
||||
"The " { $vocab-link "specialized-vectors" } " vocabulary provides a resizable version of this abstraction." ;
|
||||
|
||||
ABOUT: "specialized-arrays"
|
||||
|
|
|
@ -1,9 +1,16 @@
|
|||
IN: specialized-arrays.tests
|
||||
USING: tools.test alien.syntax specialized-arrays sequences
|
||||
specialized-arrays.int specialized-arrays.bool
|
||||
specialized-arrays.ushort alien.c-types accessors kernel
|
||||
specialized-arrays.char specialized-arrays.uint
|
||||
specialized-arrays.float arrays combinators compiler ;
|
||||
USING: tools.test alien.syntax specialized-arrays
|
||||
specialized-arrays sequences alien.c-types accessors
|
||||
kernel arrays combinators compiler classes.struct
|
||||
combinators.smart compiler.tree.debugger math libc destructors
|
||||
sequences.private ;
|
||||
|
||||
SPECIALIZED-ARRAY: int
|
||||
SPECIALIZED-ARRAY: bool
|
||||
SPECIALIZED-ARRAY: ushort
|
||||
SPECIALIZED-ARRAY: char
|
||||
SPECIALIZED-ARRAY: uint
|
||||
SPECIALIZED-ARRAY: float
|
||||
|
||||
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
|
||||
|
||||
|
@ -37,3 +44,65 @@ specialized-arrays.float arrays combinators compiler ;
|
|||
3 ALIEN: 123 100 <direct-ushort-array> new-sequence
|
||||
dup [ drop 0 ] change-each
|
||||
] unit-test
|
||||
|
||||
STRUCT: test-struct
|
||||
{ x int }
|
||||
{ y int } ;
|
||||
|
||||
SPECIALIZED-ARRAY: test-struct
|
||||
|
||||
[ 1 ] [
|
||||
1 test-struct-array{ } new-sequence length
|
||||
] unit-test
|
||||
|
||||
[ V{ test-struct } ] [
|
||||
[ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
|
||||
] unit-test
|
||||
|
||||
: make-point ( x y -- struct )
|
||||
test-struct <struct-boa> ;
|
||||
|
||||
[ 5/4 ] [
|
||||
2 <test-struct-array>
|
||||
1 2 make-point over set-first
|
||||
3 4 make-point over set-second
|
||||
0 [ [ x>> ] [ y>> ] bi / + ] reduce
|
||||
] unit-test
|
||||
|
||||
[ 5/4 ] [
|
||||
[
|
||||
2 malloc-test-struct-array
|
||||
dup &free drop
|
||||
1 2 make-point over set-first
|
||||
3 4 make-point over set-second
|
||||
0 [ [ x>> ] [ y>> ] bi / + ] reduce
|
||||
] with-destructors
|
||||
] unit-test
|
||||
|
||||
[ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
10 malloc-test-struct-array
|
||||
&free drop
|
||||
] with-destructors
|
||||
] unit-test
|
||||
|
||||
[ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
|
||||
|
||||
[ S{ test-struct f 12 20 } ] [
|
||||
test-struct-array{
|
||||
S{ test-struct f 4 20 }
|
||||
S{ test-struct f 12 20 }
|
||||
S{ test-struct f 20 20 }
|
||||
} second
|
||||
] unit-test
|
||||
|
||||
! Regression
|
||||
STRUCT: fixed-string { text char[100] } ;
|
||||
|
||||
SPECIALIZED-ARRAY: fixed-string
|
||||
|
||||
[ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
|
||||
ALIEN: 123 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
|
||||
] unit-test
|
||||
|
|
|
@ -1,13 +1,156 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences vocabs vocabs.loader ;
|
||||
USING: accessors alien alien.c-types assocs byte-arrays classes
|
||||
compiler.units functors io kernel lexer libc math
|
||||
math.vectors.specialization namespaces parser
|
||||
prettyprint.custom sequences sequences.private strings summary
|
||||
vocabs vocabs.loader vocabs.parser words ;
|
||||
IN: specialized-arrays
|
||||
|
||||
MIXIN: specialized-array
|
||||
|
||||
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" ;
|
||||
|
||||
: (underlying) ( n c-type -- array )
|
||||
heap-size * (byte-array) ; inline
|
||||
|
||||
: <underlying> ( n type -- array )
|
||||
heap-size * <byte-array> ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
FUNCTOR: define-array ( T -- )
|
||||
|
||||
A DEFINES-CLASS ${T}-array
|
||||
S DEFINES-CLASS ${T}-sequence
|
||||
<A> DEFINES <${A}>
|
||||
(A) DEFINES (${A})
|
||||
<direct-A> DEFINES <direct-${A}>
|
||||
malloc-A DEFINES malloc-${A}
|
||||
>A DEFINES >${A}
|
||||
byte-array>A DEFINES byte-array>${A}
|
||||
|
||||
A{ DEFINES ${A}{
|
||||
A@ DEFINES ${A}@
|
||||
|
||||
NTH [ T dup c-type-getter-boxer array-accessor ]
|
||||
SET-NTH [ T dup c-setter array-accessor ]
|
||||
|
||||
WHERE
|
||||
|
||||
MIXIN: S
|
||||
|
||||
TUPLE: A
|
||||
{ underlying c-ptr read-only }
|
||||
{ length array-capacity read-only } ;
|
||||
|
||||
: <direct-A> ( alien len -- specialized-array ) A boa ; inline
|
||||
|
||||
: <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
|
||||
|
||||
: byte-array>A ( byte-array -- specialized-array )
|
||||
dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
|
||||
<direct-A> ; inline
|
||||
|
||||
M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
|
||||
|
||||
M: A length length>> ; inline
|
||||
|
||||
M: A nth-unsafe underlying>> NTH call ; inline
|
||||
|
||||
M: A set-nth-unsafe underlying>> SET-NTH call ; inline
|
||||
|
||||
: >A ( seq -- specialized-array ) A new clone-like ;
|
||||
|
||||
M: A like drop dup A instance? [ >A ] unless ; inline
|
||||
|
||||
M: A new-sequence drop (A) ; inline
|
||||
|
||||
M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
|
||||
|
||||
M: A resize
|
||||
[
|
||||
[ T heap-size * ] [ underlying>> ] bi*
|
||||
resize-byte-array
|
||||
] [ drop ] 2bi
|
||||
<direct-A> ; inline
|
||||
|
||||
M: A byte-length underlying>> length ; inline
|
||||
M: A pprint-delims drop \ A{ \ } ;
|
||||
M: A >pprint-sequence ;
|
||||
|
||||
SYNTAX: A{ \ } [ >A ] parse-literal ;
|
||||
SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
|
||||
|
||||
INSTANCE: A specialized-array
|
||||
|
||||
A T c-type-boxed-class f specialize-vector-words
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
: underlying-type ( c-type -- c-type' )
|
||||
dup c-types get at string? [
|
||||
c-types get at underlying-type
|
||||
] when ;
|
||||
|
||||
: specialized-array-vocab ( c-type -- vocab )
|
||||
"specialized-arrays.instances." prepend ;
|
||||
|
||||
: defining-array-message ( type -- )
|
||||
"quiet" get [ drop ] [
|
||||
"Generating specialized " " arrays..." surround print
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: define-array-vocab ( type -- vocab )
|
||||
underlying-type
|
||||
dup specialized-array-vocab vocab
|
||||
[ ] [
|
||||
[ defining-array-message ]
|
||||
[
|
||||
[
|
||||
dup specialized-array-vocab
|
||||
[ define-array ] with-current-vocab
|
||||
] with-compilation-unit
|
||||
]
|
||||
[ specialized-array-vocab ]
|
||||
tri
|
||||
] ?if ;
|
||||
|
||||
M: string require-c-array define-array-vocab drop ;
|
||||
|
||||
ERROR: specialized-array-vocab-not-loaded c-type ;
|
||||
|
||||
M: string c-array-constructor
|
||||
underlying-type
|
||||
dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
M: string c-(array)-constructor
|
||||
underlying-type
|
||||
dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
M: string c-direct-array-constructor
|
||||
underlying-type
|
||||
dup [ "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
|
||||
[ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
|
||||
|
||||
SYNTAX: SPECIALIZED-ARRAY:
|
||||
scan define-array-vocab use-vocab ;
|
||||
|
||||
"prettyprint" vocab [
|
||||
"specialized-arrays.prettyprint" require
|
||||
] when
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.uchar
|
||||
|
||||
<< "uchar" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.uint
|
||||
|
||||
<< "uint" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.ulong
|
||||
|
||||
<< "ulong" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.ulonglong
|
||||
|
||||
<< "ulonglong" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USE: specialized-arrays.functor
|
||||
IN: specialized-arrays.ushort
|
||||
|
||||
<< "ushort" define-array >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.alien ;
|
||||
IN: specialized-vectors.alien
|
||||
|
||||
<< "void*" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.bool ;
|
||||
IN: specialized-vectors.bool
|
||||
|
||||
<< "bool" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.char ;
|
||||
IN: specialized-vectors.char
|
||||
|
||||
<< "char" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.double ;
|
||||
IN: specialized-vectors.double
|
||||
|
||||
<< "double" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.float ;
|
||||
IN: specialized-vectors.float
|
||||
|
||||
<< "float" define-vector >>
|
|
@ -1,38 +0,0 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types functors sequences sequences.private growable
|
||||
prettyprint.custom kernel words classes math parser ;
|
||||
QUALIFIED: vectors.functor
|
||||
IN: specialized-vectors.functor
|
||||
|
||||
FUNCTOR: define-vector ( T -- )
|
||||
|
||||
V DEFINES-CLASS ${T}-vector
|
||||
|
||||
A IS ${T}-array
|
||||
S IS ${T}-sequence
|
||||
<A> IS <${A}>
|
||||
|
||||
>V DEFERS >${V}
|
||||
V{ DEFINES ${V}{
|
||||
|
||||
WHERE
|
||||
|
||||
V A <A> vectors.functor:define-vector
|
||||
|
||||
M: V contract 2drop ;
|
||||
|
||||
M: V byte-length underlying>> byte-length ;
|
||||
|
||||
M: V pprint-delims drop \ V{ \ } ;
|
||||
|
||||
M: V >pprint-sequence ;
|
||||
|
||||
M: V pprint* pprint-object ;
|
||||
|
||||
SYNTAX: V{ \ } [ >V ] parse-literal ;
|
||||
|
||||
INSTANCE: V growable
|
||||
INSTANCE: V S
|
||||
|
||||
;FUNCTOR
|
|
@ -1 +0,0 @@
|
|||
Code generation for specialized vectors
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.int ;
|
||||
IN: specialized-vectors.int
|
||||
|
||||
<< "int" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.long ;
|
||||
IN: specialized-vectors.long
|
||||
|
||||
<< "long" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.longlong ;
|
||||
IN: specialized-vectors.longlong
|
||||
|
||||
<< "longlong" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.short ;
|
||||
IN: specialized-vectors.short
|
||||
|
||||
<< "short" define-vector >>
|
|
@ -1,35 +1,28 @@
|
|||
USING: help.markup help.syntax byte-vectors ;
|
||||
USING: help.markup help.syntax byte-vectors alien byte-arrays ;
|
||||
IN: specialized-vectors
|
||||
|
||||
ARTICLE: "specialized-vectors" "Specialized vectors"
|
||||
"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
|
||||
$nl
|
||||
"For each primitive C type " { $snippet "T" } ", a set of words are defined:"
|
||||
HELP: SPECIALIZED-VECTOR:
|
||||
{ $syntax "SPECIALIZED-VECTOR: type" }
|
||||
{ $values { "type" "a C type" } }
|
||||
{ $description "Brings a specialized vector for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-vector-words" } "." } ;
|
||||
|
||||
ARTICLE: "specialized-vector-words" "Specialized vector words"
|
||||
"The " { $link POSTPONE: SPECIALIZED-VECTOR: } " parsing word generates the specialized vector type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:"
|
||||
{ $table
|
||||
{ { $snippet "T-vector" } { "The class of vectors with elements of type " { $snippet "T" } } }
|
||||
{ { $snippet "<T-vector>" } { "Constructor for vectors with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- vector )" } } }
|
||||
{ { $snippet ">T-vector" } { "Converts a sequence into a specialized vector of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- vector )" } } }
|
||||
{ { $snippet "T-vector{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } }
|
||||
}
|
||||
"The primitive C types for which specialized vectors exist:"
|
||||
{ $list
|
||||
{ $snippet "char" }
|
||||
{ $snippet "uchar" }
|
||||
{ $snippet "short" }
|
||||
{ $snippet "ushort" }
|
||||
{ $snippet "int" }
|
||||
{ $snippet "uint" }
|
||||
{ $snippet "long" }
|
||||
{ $snippet "ulong" }
|
||||
{ $snippet "longlong" }
|
||||
{ $snippet "ulonglong" }
|
||||
{ $snippet "float" }
|
||||
{ $snippet "double" }
|
||||
{ $snippet "void*" }
|
||||
{ $snippet "bool" }
|
||||
}
|
||||
"Specialized vectors are generated with a functor in the " { $vocab-link "specialized-vectors.functor" } " vocabulary."
|
||||
$nl
|
||||
"The " { $vocab-link "specialized-arrays" } " vocabulary provides fixed-length versions of the above." ;
|
||||
"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-vectors.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-VECTOR: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
|
||||
|
||||
ARTICLE: "specialized-vector-c" "Passing specialized arrays to C functions"
|
||||
"Each specialized array has a " { $slot "underlying" } " slot holding a specialized array, which in turn has an " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. Passing a specialized vector as a parameter to a C function call will automatically extract the underlying data. To get at the underlying data directly, call the " { $link >c-ptr } " word on a specialized vector." ;
|
||||
|
||||
ARTICLE: "specialized-vectors" "Specialized vectors"
|
||||
"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
|
||||
{ $subsection "specialized-vector-words" }
|
||||
{ $subsection "specialized-vector-c" }
|
||||
"The " { $vocab-link "specialized-arrays" } " vocabulary provides a fixed-length version of this abstraction." ;
|
||||
|
||||
ABOUT: "specialized-vectors"
|
||||
|
|
|
@ -1,8 +1,9 @@
|
|||
IN: specialized-vectors.tests
|
||||
USING: specialized-arrays.float
|
||||
specialized-vectors.float
|
||||
specialized-vectors.double
|
||||
USING: specialized-arrays specialized-vectors
|
||||
tools.test kernel sequences ;
|
||||
SPECIALIZED-ARRAY: float
|
||||
SPECIALIZED-VECTOR: float
|
||||
SPECIALIZED-VECTOR: double
|
||||
|
||||
[ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test
|
||||
|
||||
|
|
|
@ -1,3 +1,72 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types assocs compiler.units functors
|
||||
growable io kernel lexer namespaces parser prettyprint.custom
|
||||
sequences specialized-arrays specialized-arrays.private strings
|
||||
vocabs vocabs.parser ;
|
||||
QUALIFIED: vectors.functor
|
||||
IN: specialized-vectors
|
||||
|
||||
<PRIVATE
|
||||
|
||||
FUNCTOR: define-vector ( T -- )
|
||||
|
||||
V DEFINES-CLASS ${T}-vector
|
||||
|
||||
A IS ${T}-array
|
||||
S IS ${T}-sequence
|
||||
<A> IS <${A}>
|
||||
|
||||
>V DEFERS >${V}
|
||||
V{ DEFINES ${V}{
|
||||
|
||||
WHERE
|
||||
|
||||
V A <A> vectors.functor:define-vector
|
||||
|
||||
M: V contract 2drop ;
|
||||
|
||||
M: V byte-length underlying>> byte-length ;
|
||||
|
||||
M: V pprint-delims drop \ V{ \ } ;
|
||||
|
||||
M: V >pprint-sequence ;
|
||||
|
||||
M: V pprint* pprint-object ;
|
||||
|
||||
SYNTAX: V{ \ } [ >V ] parse-literal ;
|
||||
|
||||
INSTANCE: V growable
|
||||
INSTANCE: V S
|
||||
|
||||
;FUNCTOR
|
||||
|
||||
: specialized-vector-vocab ( type -- vocab )
|
||||
"specialized-vectors.instances." prepend ;
|
||||
|
||||
: defining-vector-message ( type -- )
|
||||
"quiet" get [ drop ] [
|
||||
"Generating specialized " " vectors..." surround print
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: define-vector-vocab ( type -- vocab )
|
||||
underlying-type
|
||||
dup specialized-vector-vocab vocab
|
||||
[ ] [
|
||||
[ defining-vector-message ]
|
||||
[
|
||||
[
|
||||
dup specialized-vector-vocab
|
||||
[ define-vector ] with-current-vocab
|
||||
] with-compilation-unit
|
||||
]
|
||||
[ specialized-vector-vocab ]
|
||||
tri
|
||||
] ?if ;
|
||||
|
||||
SYNTAX: SPECIALIZED-VECTOR:
|
||||
scan
|
||||
[ define-array-vocab use-vocab ]
|
||||
[ define-vector-vocab use-vocab ] bi ;
|
||||
|
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.uchar ;
|
||||
IN: specialized-vectors.uchar
|
||||
|
||||
<< "uchar" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.uint ;
|
||||
IN: specialized-vectors.uint
|
||||
|
||||
<< "uint" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.ulong ;
|
||||
IN: specialized-vectors.ulong
|
||||
|
||||
<< "ulong" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.ulonglong ;
|
||||
IN: specialized-vectors.ulonglong
|
||||
|
||||
<< "ulonglong" define-vector >>
|
|
@ -1,4 +0,0 @@
|
|||
USING: specialized-vectors.functor specialized-arrays.ushort ;
|
||||
IN: specialized-vectors.ushort
|
||||
|
||||
<< "ushort" define-vector >>
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue