From 9fb0dcd9bde23b961af7300198d2b5da97db46ff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 10 Aug 2009 16:17:33 -0500 Subject: [PATCH] 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 --- basis/alien/arrays/arrays.factor | 7 +++++-- basis/alien/c-types/c-types.factor | 20 +++++++++++++++++++ basis/alien/complex/complex-tests.factor | 6 +++++- basis/alien/complex/functor/functor.factor | 2 +- basis/alien/structs/structs.factor | 1 + .../specialized-arrays/functor/functor.factor | 2 +- 6 files changed, 33 insertions(+), 5 deletions(-) diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index 4786c85bd4..d793814c28 100755 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -11,6 +11,8 @@ M: array c-type ; 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 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-class - drop object ; +M: string-type c-type-class drop object ; + +M: string-type c-type-boxed-class drop object ; M: string-type heap-size drop "void*" heap-size ; diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 7807113999..2eba6a2b9e 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -15,6 +15,7 @@ DEFER: *char TUPLE: abstract-c-type { class class initial: object } +{ boxed-class class initial: object } { boxer-quot callable } { unboxer-quot 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 ; +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 ) M: c-type c-type-boxer boxer>> ; @@ -300,6 +307,7 @@ CONSTANT: primitive-types [ c-ptr >>class + c-ptr >>boxed-class [ alien-cell ] >>getter [ [ >c-ptr ] 2dip set-alien-cell ] >>setter bootstrap-cell >>size @@ -311,6 +319,7 @@ CONSTANT: primitive-types integer >>class + integer >>boxed-class [ alien-signed-8 ] >>getter [ set-alien-signed-8 ] >>setter 8 >>size @@ -321,6 +330,7 @@ CONSTANT: primitive-types integer >>class + integer >>boxed-class [ alien-unsigned-8 ] >>getter [ set-alien-unsigned-8 ] >>setter 8 >>size @@ -331,6 +341,7 @@ CONSTANT: primitive-types integer >>class + integer >>boxed-class [ alien-signed-cell ] >>getter [ set-alien-signed-cell ] >>setter bootstrap-cell >>size @@ -341,6 +352,7 @@ CONSTANT: primitive-types integer >>class + integer >>boxed-class [ alien-unsigned-cell ] >>getter [ set-alien-unsigned-cell ] >>setter bootstrap-cell >>size @@ -351,6 +363,7 @@ CONSTANT: primitive-types integer >>class + integer >>boxed-class [ alien-signed-4 ] >>getter [ set-alien-signed-4 ] >>setter 4 >>size @@ -361,6 +374,7 @@ CONSTANT: primitive-types integer >>class + integer >>boxed-class [ alien-unsigned-4 ] >>getter [ set-alien-unsigned-4 ] >>setter 4 >>size @@ -371,6 +385,7 @@ CONSTANT: primitive-types fixnum >>class + fixnum >>boxed-class [ alien-signed-2 ] >>getter [ set-alien-signed-2 ] >>setter 2 >>size @@ -381,6 +396,7 @@ CONSTANT: primitive-types fixnum >>class + fixnum >>boxed-class [ alien-unsigned-2 ] >>getter [ set-alien-unsigned-2 ] >>setter 2 >>size @@ -391,6 +407,7 @@ CONSTANT: primitive-types fixnum >>class + fixnum >>boxed-class [ alien-signed-1 ] >>getter [ set-alien-signed-1 ] >>setter 1 >>size @@ -401,6 +418,7 @@ CONSTANT: primitive-types fixnum >>class + fixnum >>boxed-class [ alien-unsigned-1 ] >>getter [ set-alien-unsigned-1 ] >>setter 1 >>size @@ -420,6 +438,7 @@ CONSTANT: primitive-types float >>class + float >>boxed-class [ alien-float ] >>getter [ [ >float ] 2dip set-alien-float ] >>setter 4 >>size @@ -432,6 +451,7 @@ CONSTANT: primitive-types float >>class + float >>boxed-class [ alien-double ] >>getter [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size diff --git a/basis/alien/complex/complex-tests.factor b/basis/alien/complex/complex-tests.factor index 0bff73b898..e84bb322e2 100644 --- a/basis/alien/complex/complex-tests.factor +++ b/basis/alien/complex/complex-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: tools.test alien.complex kernel alien.c-types alien.syntax -namespaces ; +namespaces math ; IN: alien.complex.tests C-STRUCT: complex-holder @@ -16,3 +16,7 @@ C-STRUCT: complex-holder ] 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 \ No newline at end of file diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor index 59bf3451b8..98d412639f 100644 --- a/basis/alien/complex/functor/functor.factor +++ b/basis/alien/complex/functor/functor.factor @@ -30,7 +30,7 @@ define-struct T c-type 1quotation >>unboxer-quot *T 1quotation >>boxer-quot -number >>class +number >>boxed-class drop ;FUNCTOR diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor index 4154ad1dd8..5c1fb4063b 100755 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -39,6 +39,7 @@ M: struct-type stack-size [ [ align ] keep ] dip struct-type new byte-array >>class + byte-array >>boxed-class swap >>fields swap >>align swap >>size diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index beb4aa89ac..1c855be1a4 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -74,6 +74,6 @@ SYNTAX: A{ \ } [ >A ] parse-literal ; INSTANCE: A sequence -A T c-type class>> specialize-vector-words +A T c-type-boxed-class specialize-vector-words ;FUNCTOR