Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
a81ebb2657
|
|
@ -1,6 +1,7 @@
|
|||
! (c)Joe Groff bsd license
|
||||
USING: alien arrays classes help.markup help.syntax kernel math
|
||||
USING: alien arrays classes help.markup help.syntax kernel
|
||||
specialized-arrays.direct ;
|
||||
QUALIFIED: math
|
||||
IN: classes.c-types
|
||||
|
||||
HELP: c-type-class
|
||||
|
|
@ -11,7 +12,7 @@ HELP: char
|
|||
|
||||
HELP: direct-array-of
|
||||
{ $values
|
||||
{ "alien" c-ptr } { "len" integer } { "class" c-type-class }
|
||||
{ "alien" c-ptr } { "len" math:integer } { "class" c-type-class }
|
||||
{ "array" "a direct array" }
|
||||
}
|
||||
{ $description "Constructs one of the " { $link "specialized-arrays.direct" } " over " { $snippet "len" } " elements of type " { $snippet "class" } " located at the referenced location in raw memory." } ;
|
||||
|
|
@ -28,12 +29,18 @@ HELP: longlong
|
|||
HELP: short
|
||||
{ $class-description "A signed two-byte integer quantity." } ;
|
||||
|
||||
HELP: single-complex
|
||||
HELP: complex-float
|
||||
{ $class-description "A single-precision complex floating point quantity." } ;
|
||||
|
||||
HELP: single-float
|
||||
HELP: complex-double
|
||||
{ $class-description "A double-precision complex floating point quantity. This is an alias for the Factor " { $link math:complex } " type." } ;
|
||||
|
||||
HELP: float
|
||||
{ $class-description "A single-precision floating point quantity." } ;
|
||||
|
||||
HELP: double
|
||||
{ $class-description "A double-precision floating point quantity. This is an alias for the Factor " { $link math:float } " type." } ;
|
||||
|
||||
HELP: uchar
|
||||
{ $class-description "An unsigned one-byte integer quantity." } ;
|
||||
|
||||
|
|
@ -49,6 +56,12 @@ HELP: ulonglong
|
|||
HELP: ushort
|
||||
{ $class-description "An unsigned two-byte integer quantity." } ;
|
||||
|
||||
HELP: bool
|
||||
{ $class-description "A boolean value. This is an alias to the Factor " { $link boolean } " class." } ;
|
||||
|
||||
HELP: void*
|
||||
{ $class-description "A pointer to raw C memory. This is an alias to the Factor " { $link pinned-c-ptr } " class." } ;
|
||||
|
||||
ARTICLE: "classes.c-types" "C type classes"
|
||||
"The " { $vocab-link "classes.c-types" } " vocabulary defines Factor classes that correspond to C types in the FFI."
|
||||
{ $subsection char }
|
||||
|
|
@ -61,11 +74,12 @@ ARTICLE: "classes.c-types" "C type classes"
|
|||
{ $subsection ulong }
|
||||
{ $subsection longlong }
|
||||
{ $subsection ulonglong }
|
||||
{ $subsection single-float }
|
||||
{ $subsection float }
|
||||
{ $subsection single-complex }
|
||||
{ $subsection complex }
|
||||
{ $subsection pinned-c-ptr }
|
||||
{ $subsection double }
|
||||
{ $subsection complex-float }
|
||||
{ $subsection complex-double }
|
||||
{ $subsection bool }
|
||||
{ $subsection void* }
|
||||
"The vocabulary also provides a word for constructing " { $link "specialized-arrays.direct" } " of C types over raw memory:"
|
||||
{ $subsection direct-array-of } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! (c)Joe Groff bsd license
|
||||
USING: alien alien.c-types classes classes.predicate kernel
|
||||
math math.bitwise math.order namespaces sequences words
|
||||
math.bitwise math.order namespaces sequences words
|
||||
specialized-arrays.direct.alien
|
||||
specialized-arrays.direct.bool
|
||||
specialized-arrays.direct.char
|
||||
|
|
@ -17,46 +17,53 @@ specialized-arrays.direct.uint
|
|||
specialized-arrays.direct.ulong
|
||||
specialized-arrays.direct.ulonglong
|
||||
specialized-arrays.direct.ushort ;
|
||||
QUALIFIED: math
|
||||
IN: classes.c-types
|
||||
|
||||
PREDICATE: char < fixnum
|
||||
PREDICATE: char < math:fixnum
|
||||
HEX: -80 HEX: 7f between? ;
|
||||
|
||||
PREDICATE: uchar < fixnum
|
||||
PREDICATE: uchar < math:fixnum
|
||||
HEX: 0 HEX: ff between? ;
|
||||
|
||||
PREDICATE: short < fixnum
|
||||
PREDICATE: short < math:fixnum
|
||||
HEX: -8000 HEX: 7fff between? ;
|
||||
|
||||
PREDICATE: ushort < fixnum
|
||||
PREDICATE: ushort < math:fixnum
|
||||
HEX: 0 HEX: ffff between? ;
|
||||
|
||||
PREDICATE: int < integer
|
||||
PREDICATE: int < math:integer
|
||||
HEX: -8000,0000 HEX: 7fff,ffff between? ;
|
||||
|
||||
PREDICATE: uint < integer
|
||||
PREDICATE: uint < math:integer
|
||||
HEX: 0 HEX: ffff,ffff between? ;
|
||||
|
||||
PREDICATE: longlong < integer
|
||||
PREDICATE: longlong < math:integer
|
||||
HEX: -8000,0000,0000,0000 HEX: 7fff,ffff,ffff,ffff between? ;
|
||||
|
||||
PREDICATE: ulonglong < integer
|
||||
PREDICATE: ulonglong < math:integer
|
||||
HEX: 0 HEX: ffff,ffff,ffff,ffff between? ;
|
||||
|
||||
UNION: single-float float ;
|
||||
UNION: single-complex complex ;
|
||||
UNION: double math:float ;
|
||||
UNION: complex-double math:complex ;
|
||||
|
||||
UNION: bool boolean ;
|
||||
UNION: void* pinned-c-ptr ;
|
||||
|
||||
UNION: float math:float ;
|
||||
UNION: complex-float math:complex ;
|
||||
|
||||
SYMBOLS: long ulong long-bits ;
|
||||
|
||||
<<
|
||||
"long" heap-size 8 =
|
||||
[
|
||||
\ long integer [ HEX: -8000,0000,0000,0000 HEX: 7fff,ffff,ffff,ffff between? ] define-predicate-class
|
||||
\ ulong integer [ HEX: 0 HEX: ffff,ffff,ffff,ffff between? ] define-predicate-class
|
||||
\ long math:integer [ HEX: -8000,0000,0000,0000 HEX: 7fff,ffff,ffff,ffff between? ] define-predicate-class
|
||||
\ ulong math:integer [ HEX: 0 HEX: ffff,ffff,ffff,ffff between? ] define-predicate-class
|
||||
64 \ long-bits set-global
|
||||
] [
|
||||
\ long integer [ HEX: -8000,0000 HEX: 7fff,ffff between? ] define-predicate-class
|
||||
\ ulong integer [ HEX: 0 HEX: ffff,ffff between? ] define-predicate-class
|
||||
\ long math:integer [ HEX: -8000,0000 HEX: 7fff,ffff between? ] define-predicate-class
|
||||
\ ulong math:integer [ HEX: 0 HEX: ffff,ffff between? ] define-predicate-class
|
||||
32 \ long-bits set-global
|
||||
] if
|
||||
>>
|
||||
|
|
@ -72,7 +79,9 @@ SYMBOLS: long ulong long-bits ;
|
|||
"class-direct-array" word-prop ;
|
||||
|
||||
\ f f "void*" \ <direct-void*-array> set-class-c-type
|
||||
void* f "void*" \ <direct-void*-array> set-class-c-type
|
||||
pinned-c-ptr f "void*" \ <direct-void*-array> set-class-c-type
|
||||
bool f "bool" \ <direct-bool-array> set-class-c-type
|
||||
boolean f "bool" \ <direct-bool-array> set-class-c-type
|
||||
char 0 "char" \ <direct-char-array> set-class-c-type
|
||||
uchar 0 "uchar" \ <direct-uchar-array> set-class-c-type
|
||||
|
|
@ -84,10 +93,10 @@ long 0 "long" \ <direct-long-array> set
|
|||
ulong 0 "ulong" \ <direct-ulong-array> set-class-c-type
|
||||
longlong 0 "longlong" \ <direct-longlong-array> set-class-c-type
|
||||
ulonglong 0 "ulonglong" \ <direct-ulonglong-array> set-class-c-type
|
||||
float 0.0 "double" \ <direct-double-array> set-class-c-type
|
||||
single-float 0.0 "float" \ <direct-float-array> set-class-c-type
|
||||
complex C{ 0.0 0.0 } "complex-double" \ <direct-complex-double-array> set-class-c-type
|
||||
single-complex C{ 0.0 0.0 } "complex-float" \ <direct-complex-float-array> set-class-c-type
|
||||
float 0.0 "float" \ <direct-float-array> set-class-c-type
|
||||
double 0.0 "double" \ <direct-double-array> set-class-c-type
|
||||
complex-float C{ 0.0 0.0 } "complex-float" \ <direct-complex-float-array> set-class-c-type
|
||||
complex-double C{ 0.0 0.0 } "complex-double" \ <direct-complex-double-array> set-class-c-type
|
||||
|
||||
char [ 8 bits 8 >signed ] "coercer" set-word-prop
|
||||
uchar [ 8 bits ] "coercer" set-word-prop
|
||||
|
|
|
|||
|
|
@ -1,13 +1,15 @@
|
|||
! (c)Joe Groff bsd license
|
||||
USING: accessors alien.c-types alien.structs.fields classes.c-types
|
||||
classes.struct combinators io.streams.string kernel libc literals math
|
||||
multiline namespaces prettyprint prettyprint.config see tools.test ;
|
||||
USING: accessors alien.c-types alien.structs.fields alien.syntax
|
||||
classes.c-types classes.struct combinators io.streams.string kernel
|
||||
libc literals math multiline namespaces prettyprint prettyprint.config
|
||||
see tools.test ;
|
||||
FROM: classes.c-types => float ;
|
||||
IN: classes.struct.tests
|
||||
|
||||
STRUCT: struct-test-foo
|
||||
{ x char }
|
||||
{ y int initial: 123 }
|
||||
{ z boolean } ;
|
||||
{ z bool } ;
|
||||
|
||||
STRUCT: struct-test-bar
|
||||
{ w ushort initial: HEX: ffff }
|
||||
|
|
@ -32,7 +34,7 @@ STRUCT: struct-test-bar
|
|||
[ 7654 ] [ S{ struct-test-foo { y 7654 } } y>> ] unit-test
|
||||
|
||||
UNION-STRUCT: struct-test-float-and-bits
|
||||
{ f single-float }
|
||||
{ f float }
|
||||
{ bits uint } ;
|
||||
|
||||
[ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
|
||||
|
|
@ -65,7 +67,7 @@ STRUCT: struct-test-foo
|
|||
[ <" USING: classes.c-types classes.struct ;
|
||||
IN: classes.struct.tests
|
||||
UNION-STRUCT: struct-test-float-and-bits
|
||||
{ f single-float initial: 0.0 } { bits uint initial: 0 } ;
|
||||
{ f float initial: 0.0 } { bits uint initial: 0 } ;
|
||||
"> ]
|
||||
[ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
|
||||
|
||||
|
|
@ -73,21 +75,21 @@ UNION-STRUCT: struct-test-float-and-bits
|
|||
T{ field-spec
|
||||
{ name "x" }
|
||||
{ offset 0 }
|
||||
{ type $[ char c-type ] }
|
||||
{ type char }
|
||||
{ reader x>> }
|
||||
{ writer (>>x) }
|
||||
}
|
||||
T{ field-spec
|
||||
{ name "y" }
|
||||
{ offset 4 }
|
||||
{ type $[ int c-type ] }
|
||||
{ type int }
|
||||
{ reader y>> }
|
||||
{ writer (>>y) }
|
||||
}
|
||||
T{ field-spec
|
||||
{ name "z" }
|
||||
{ offset 8 }
|
||||
{ type $[ boolean c-type ] }
|
||||
{ type bool }
|
||||
{ reader z>> }
|
||||
{ writer (>>z) }
|
||||
}
|
||||
|
|
@ -97,16 +99,24 @@ UNION-STRUCT: struct-test-float-and-bits
|
|||
T{ field-spec
|
||||
{ name "f" }
|
||||
{ offset 0 }
|
||||
{ type $[ single-float c-type ] }
|
||||
{ type float }
|
||||
{ reader f>> }
|
||||
{ writer (>>f) }
|
||||
}
|
||||
T{ field-spec
|
||||
{ name "bits" }
|
||||
{ offset 0 }
|
||||
{ type $[ uint c-type ] }
|
||||
{ type uint }
|
||||
{ reader bits>> }
|
||||
{ writer (>>bits) }
|
||||
}
|
||||
} ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
|
||||
|
||||
STRUCT: struct-test-ffi-foo
|
||||
{ x int }
|
||||
{ y int } ;
|
||||
|
||||
LIBRARY: f-cdecl
|
||||
FUNCTION: int ffi_test_11 ( int a, struct-test-ffi-foo b, int c ) ;
|
||||
|
||||
[ 14 ] [ 1 2 3 struct-test-ffi-foo <struct-boa> 4 ffi_test_11 ] unit-test
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@ M: struct-class writer-quot
|
|||
field-spec new swap {
|
||||
[ name>> >>name ]
|
||||
[ offset>> >>offset ]
|
||||
[ class>> c-type >>type ]
|
||||
[ class>> >>type ]
|
||||
[ name>> reader-word >>reader ]
|
||||
[ name>> writer-word >>writer ]
|
||||
} cleave ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue