alien: need to differentiate between the type of the result before and after boxing; the former is used by propagation for #alien-invoke nodes and the latter is used by specialized arrays. This fixes FFI unit test failures
parent
e9d5b364b3
commit
9fb0dcd9bd
|
@ -11,6 +11,8 @@ M: array c-type ;
|
||||||
|
|
||||||
M: array c-type-class drop object ;
|
M: array c-type-class drop object ;
|
||||||
|
|
||||||
|
M: array c-type-boxed-class drop object ;
|
||||||
|
|
||||||
M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
|
M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
|
||||||
|
|
||||||
M: array c-type-align first c-type-align ;
|
M: array c-type-align first c-type-align ;
|
||||||
|
@ -45,8 +47,9 @@ PREDICATE: string-type < pair
|
||||||
|
|
||||||
M: string-type c-type ;
|
M: string-type c-type ;
|
||||||
|
|
||||||
M: string-type c-type-class
|
M: string-type c-type-class drop object ;
|
||||||
drop object ;
|
|
||||||
|
M: string-type c-type-boxed-class drop object ;
|
||||||
|
|
||||||
M: string-type heap-size
|
M: string-type heap-size
|
||||||
drop "void*" heap-size ;
|
drop "void*" heap-size ;
|
||||||
|
|
|
@ -15,6 +15,7 @@ DEFER: *char
|
||||||
|
|
||||||
TUPLE: abstract-c-type
|
TUPLE: abstract-c-type
|
||||||
{ class class initial: object }
|
{ class class initial: object }
|
||||||
|
{ boxed-class class initial: object }
|
||||||
{ boxer-quot callable }
|
{ boxer-quot callable }
|
||||||
{ unboxer-quot callable }
|
{ unboxer-quot callable }
|
||||||
{ getter callable }
|
{ getter callable }
|
||||||
|
@ -76,6 +77,12 @@ M: abstract-c-type c-type-class class>> ;
|
||||||
|
|
||||||
M: string c-type-class c-type c-type-class ;
|
M: string c-type-class c-type c-type-class ;
|
||||||
|
|
||||||
|
GENERIC: c-type-boxed-class ( name -- class )
|
||||||
|
|
||||||
|
M: abstract-c-type c-type-boxed-class boxed-class>> ;
|
||||||
|
|
||||||
|
M: string c-type-boxed-class c-type c-type-boxed-class ;
|
||||||
|
|
||||||
GENERIC: c-type-boxer ( name -- boxer )
|
GENERIC: c-type-boxer ( name -- boxer )
|
||||||
|
|
||||||
M: c-type c-type-boxer boxer>> ;
|
M: c-type c-type-boxer boxer>> ;
|
||||||
|
@ -300,6 +307,7 @@ CONSTANT: primitive-types
|
||||||
[
|
[
|
||||||
<c-type>
|
<c-type>
|
||||||
c-ptr >>class
|
c-ptr >>class
|
||||||
|
c-ptr >>boxed-class
|
||||||
[ alien-cell ] >>getter
|
[ alien-cell ] >>getter
|
||||||
[ [ >c-ptr ] 2dip set-alien-cell ] >>setter
|
[ [ >c-ptr ] 2dip set-alien-cell ] >>setter
|
||||||
bootstrap-cell >>size
|
bootstrap-cell >>size
|
||||||
|
@ -311,6 +319,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<long-long-type>
|
<long-long-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
integer >>boxed-class
|
||||||
[ alien-signed-8 ] >>getter
|
[ alien-signed-8 ] >>getter
|
||||||
[ set-alien-signed-8 ] >>setter
|
[ set-alien-signed-8 ] >>setter
|
||||||
8 >>size
|
8 >>size
|
||||||
|
@ -321,6 +330,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<long-long-type>
|
<long-long-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
integer >>boxed-class
|
||||||
[ alien-unsigned-8 ] >>getter
|
[ alien-unsigned-8 ] >>getter
|
||||||
[ set-alien-unsigned-8 ] >>setter
|
[ set-alien-unsigned-8 ] >>setter
|
||||||
8 >>size
|
8 >>size
|
||||||
|
@ -331,6 +341,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
integer >>boxed-class
|
||||||
[ alien-signed-cell ] >>getter
|
[ alien-signed-cell ] >>getter
|
||||||
[ set-alien-signed-cell ] >>setter
|
[ set-alien-signed-cell ] >>setter
|
||||||
bootstrap-cell >>size
|
bootstrap-cell >>size
|
||||||
|
@ -341,6 +352,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
integer >>boxed-class
|
||||||
[ alien-unsigned-cell ] >>getter
|
[ alien-unsigned-cell ] >>getter
|
||||||
[ set-alien-unsigned-cell ] >>setter
|
[ set-alien-unsigned-cell ] >>setter
|
||||||
bootstrap-cell >>size
|
bootstrap-cell >>size
|
||||||
|
@ -351,6 +363,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
integer >>boxed-class
|
||||||
[ alien-signed-4 ] >>getter
|
[ alien-signed-4 ] >>getter
|
||||||
[ set-alien-signed-4 ] >>setter
|
[ set-alien-signed-4 ] >>setter
|
||||||
4 >>size
|
4 >>size
|
||||||
|
@ -361,6 +374,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
integer >>class
|
integer >>class
|
||||||
|
integer >>boxed-class
|
||||||
[ alien-unsigned-4 ] >>getter
|
[ alien-unsigned-4 ] >>getter
|
||||||
[ set-alien-unsigned-4 ] >>setter
|
[ set-alien-unsigned-4 ] >>setter
|
||||||
4 >>size
|
4 >>size
|
||||||
|
@ -371,6 +385,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
fixnum >>boxed-class
|
||||||
[ alien-signed-2 ] >>getter
|
[ alien-signed-2 ] >>getter
|
||||||
[ set-alien-signed-2 ] >>setter
|
[ set-alien-signed-2 ] >>setter
|
||||||
2 >>size
|
2 >>size
|
||||||
|
@ -381,6 +396,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
fixnum >>boxed-class
|
||||||
[ alien-unsigned-2 ] >>getter
|
[ alien-unsigned-2 ] >>getter
|
||||||
[ set-alien-unsigned-2 ] >>setter
|
[ set-alien-unsigned-2 ] >>setter
|
||||||
2 >>size
|
2 >>size
|
||||||
|
@ -391,6 +407,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
fixnum >>boxed-class
|
||||||
[ alien-signed-1 ] >>getter
|
[ alien-signed-1 ] >>getter
|
||||||
[ set-alien-signed-1 ] >>setter
|
[ set-alien-signed-1 ] >>setter
|
||||||
1 >>size
|
1 >>size
|
||||||
|
@ -401,6 +418,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
fixnum >>class
|
fixnum >>class
|
||||||
|
fixnum >>boxed-class
|
||||||
[ alien-unsigned-1 ] >>getter
|
[ alien-unsigned-1 ] >>getter
|
||||||
[ set-alien-unsigned-1 ] >>setter
|
[ set-alien-unsigned-1 ] >>setter
|
||||||
1 >>size
|
1 >>size
|
||||||
|
@ -420,6 +438,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
float >>class
|
float >>class
|
||||||
|
float >>boxed-class
|
||||||
[ alien-float ] >>getter
|
[ alien-float ] >>getter
|
||||||
[ [ >float ] 2dip set-alien-float ] >>setter
|
[ [ >float ] 2dip set-alien-float ] >>setter
|
||||||
4 >>size
|
4 >>size
|
||||||
|
@ -432,6 +451,7 @@ CONSTANT: primitive-types
|
||||||
|
|
||||||
<c-type>
|
<c-type>
|
||||||
float >>class
|
float >>class
|
||||||
|
float >>boxed-class
|
||||||
[ alien-double ] >>getter
|
[ alien-double ] >>getter
|
||||||
[ [ >float ] 2dip set-alien-double ] >>setter
|
[ [ >float ] 2dip set-alien-double ] >>setter
|
||||||
8 >>size
|
8 >>size
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: tools.test alien.complex kernel alien.c-types alien.syntax
|
USING: tools.test alien.complex kernel alien.c-types alien.syntax
|
||||||
namespaces ;
|
namespaces math ;
|
||||||
IN: alien.complex.tests
|
IN: alien.complex.tests
|
||||||
|
|
||||||
C-STRUCT: complex-holder
|
C-STRUCT: complex-holder
|
||||||
|
@ -16,3 +16,7 @@ C-STRUCT: complex-holder
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test
|
[ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test
|
||||||
|
|
||||||
|
[ complex ] [ "complex-float" c-type-boxed-class ] unit-test
|
||||||
|
|
||||||
|
[ complex ] [ "complex-double" c-type-boxed-class ] unit-test
|
|
@ -30,7 +30,7 @@ define-struct
|
||||||
T c-type
|
T c-type
|
||||||
<T> 1quotation >>unboxer-quot
|
<T> 1quotation >>unboxer-quot
|
||||||
*T 1quotation >>boxer-quot
|
*T 1quotation >>boxer-quot
|
||||||
number >>class
|
number >>boxed-class
|
||||||
drop
|
drop
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -39,6 +39,7 @@ M: struct-type stack-size
|
||||||
[ [ align ] keep ] dip
|
[ [ align ] keep ] dip
|
||||||
struct-type new
|
struct-type new
|
||||||
byte-array >>class
|
byte-array >>class
|
||||||
|
byte-array >>boxed-class
|
||||||
swap >>fields
|
swap >>fields
|
||||||
swap >>align
|
swap >>align
|
||||||
swap >>size
|
swap >>size
|
||||||
|
|
|
@ -74,6 +74,6 @@ SYNTAX: A{ \ } [ >A ] parse-literal ;
|
||||||
|
|
||||||
INSTANCE: A sequence
|
INSTANCE: A sequence
|
||||||
|
|
||||||
A T c-type class>> specialize-vector-words
|
A T c-type-boxed-class specialize-vector-words
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
Loading…
Reference in New Issue