Merge branch 'master' of git://factorcode.org/git/factor
commit
b8978446d9
basis
alien
arrays
structs
stack-checker/alien
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.strings alien.c-types alien.accessors alien.structs
|
||||
arrays words sequences math kernel namespaces fry libc cpu.architecture
|
||||
io.encodings.utf8 ;
|
||||
io.encodings.utf8 accessors ;
|
||||
IN: alien.arrays
|
||||
|
||||
UNION: value-type array struct-type ;
|
||||
|
@ -13,7 +13,10 @@ M: array c-type-class drop object ;
|
|||
|
||||
M: array c-type-boxed-class drop object ;
|
||||
|
||||
M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
|
||||
: array-length ( seq -- n )
|
||||
[ dup word? [ def>> call( -- object ) ] when ] [ * ] map-reduce ;
|
||||
|
||||
M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ;
|
||||
|
||||
M: array c-type-align first c-type-align ;
|
||||
|
||||
|
@ -31,7 +34,7 @@ M: array stack-size drop "void*" stack-size ;
|
|||
|
||||
M: array c-type-boxer-quot
|
||||
unclip
|
||||
[ product ]
|
||||
[ array-length ]
|
||||
[ [ require-c-type-arrays ] keep ] bi*
|
||||
[ <c-type-direct-array> ] 2curry ;
|
||||
|
||||
|
|
|
@ -4,7 +4,7 @@ IN: alien.c-types.tests
|
|||
|
||||
CONSTANT: xyz 123
|
||||
|
||||
[ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
|
||||
[ 492 ] [ { "int" xyz } heap-size ] unit-test
|
||||
|
||||
[ -1 ] [ -1 <char> *char ] unit-test
|
||||
[ -1 ] [ -1 <short> *short ] unit-test
|
||||
|
|
|
@ -326,17 +326,6 @@ M: long-long-type box-return ( type -- )
|
|||
[ define-out ]
|
||||
tri ;
|
||||
|
||||
: expand-constants ( c-type -- c-type' )
|
||||
dup array? [
|
||||
unclip [
|
||||
[
|
||||
dup word? [
|
||||
def>> call( -- object )
|
||||
] when
|
||||
] map
|
||||
] dip prefix
|
||||
] when ;
|
||||
|
||||
: malloc-file-contents ( path -- alien len )
|
||||
binary file-contents [ malloc-byte-array ] [ length ] bi ;
|
||||
|
||||
|
|
|
@ -16,7 +16,7 @@ TUPLE: field-spec name offset type reader writer ;
|
|||
field-spec new
|
||||
0 >>offset
|
||||
swap >>name
|
||||
swap expand-constants >>type
|
||||
swap >>type
|
||||
3dup name>> swap reader-word >>reader
|
||||
3dup name>> swap writer-word >>writer
|
||||
2nip ;
|
||||
|
|
|
@ -58,7 +58,6 @@ M: struct-type stack-size
|
|||
[ define-field ] each ; deprecated
|
||||
|
||||
: define-union ( name members -- )
|
||||
[ expand-constants ] map
|
||||
[ [ heap-size ] [ max ] map-reduce ] keep
|
||||
compute-struct-align f struct-type (define-struct) ; deprecated
|
||||
|
||||
|
|
|
@ -14,9 +14,6 @@ TUPLE: alien-indirect-params < alien-node-params ;
|
|||
|
||||
TUPLE: alien-callback-params < alien-node-params quot xt ;
|
||||
|
||||
: pop-parameters ( -- seq )
|
||||
pop-literal nip [ expand-constants ] map ;
|
||||
|
||||
: param-prep-quot ( node -- quot )
|
||||
parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ;
|
||||
|
||||
|
@ -31,7 +28,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
|
|||
: infer-alien-invoke ( -- )
|
||||
alien-invoke-params new
|
||||
! Compile-time parameters
|
||||
pop-parameters >>parameters
|
||||
pop-literal nip >>parameters
|
||||
pop-literal nip >>function
|
||||
pop-literal nip >>library
|
||||
pop-literal nip >>return
|
||||
|
@ -50,7 +47,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
|
|||
alien-indirect-params new
|
||||
! Compile-time parameters
|
||||
pop-literal nip >>abi
|
||||
pop-parameters >>parameters
|
||||
pop-literal nip >>parameters
|
||||
pop-literal nip >>return
|
||||
! Quotation which coerces parameters to required types
|
||||
dup param-prep-quot [ dip ] curry infer-quot-here
|
||||
|
@ -71,7 +68,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
|
|||
alien-callback-params new
|
||||
pop-literal nip >>quot
|
||||
pop-literal nip >>abi
|
||||
pop-parameters >>parameters
|
||||
pop-literal nip >>parameters
|
||||
pop-literal nip >>return
|
||||
gensym >>xt
|
||||
dup callback-bottom
|
||||
|
|
Loading…
Reference in New Issue