Add support for C99 complex float and complex double types to FFI

They are named complex-float and complex-double in the Factor world

diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index 727492edb1567a44905df3ce9893c02ed94b9b3d..c823b614d937eda196aec904324da1e31627c171 100644 (file)
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays alien.c-types alien.structs
-sequences math kernel namespaces make libc cpu.architecture ;
+sequences math kernel namespaces fry libc cpu.architecture ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -10,7 +10,7 @@ M: array c-type ;
 
 M: array c-type-class drop object ;
 
-M: array heap-size unclip heap-size [ * ] reduce ;
+M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
 
 M: array c-type-align first c-type-align ;
 
@@ -26,16 +26,15 @@ M: array box-return drop "void*" box-return ;
 
 M: array stack-size drop "void*" stack-size ;
 
-M: value-type c-type-reg-class drop int-regs ;
+M: array c-type-boxer-quot drop f ;
 
-M: value-type c-type-boxer-quot drop f ;
+M: array c-type-unboxer-quot drop f ;
 
-M: value-type c-type-unboxer-quot drop f ;
+M: value-type c-type-reg-class drop int-regs ;
 
 M: value-type c-type-getter
     drop [ swap <displaced-alien> ] ;
 
 M: value-type c-type-setter ( type -- quot )
-    [
-        dup c-type-getter % \ swap , heap-size , \ memcpy ,
-    ] [ ] make ;
+    [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
+    '[ @ swap @ _ memcpy ] ;

diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor
index a2b555b05765fdf7e56d5ec4a0869315baddbf57..dc29ea9bb356826ce56af454aa6d157248331a6a 100644 (file)
--- a/basis/alien/c-types/c-types-docs.factor
+++ b/basis/alien/c-types/c-types-docs.factor
@@ -178,6 +178,8 @@ $nl
     { { $snippet "ulonglong" } { } }
     { { $snippet "float" } { } }
     { { $snippet "double" } { "same format as " { $link float } " objects" } }
+    { { $snippet "complex-float" } { "C99 " { $snippet "complex float" } " type, converted to and from " { $link complex } " values" } }
+    { { $snippet "complex-double" } { "C99 " { $snippet "complex double" } " type, converted to and from " { $link complex } " values" } }
 }
 "When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
 $nl

diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index 42923fb28bbe475565eb7097479f701cb3a7b22b..d9ed53d0c62eafd4385fc676bc10dc8859e6ba8d 100644 (file)
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -5,7 +5,7 @@ math namespaces parser sequences strings words libc fry
 alien.c-types alien.structs.fields cpu.architecture math.order ;
 IN: alien.structs
 
-TUPLE: struct-type size align fields ;
+TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
 
 M: struct-type heap-size size>> ;
 
@@ -15,6 +15,10 @@ M: struct-type c-type-align align>> ;
 
 M: struct-type c-type-stack-align? drop f ;
 
+M: struct-type c-type-boxer-quot boxer-quot>> ;
+
+M: struct-type c-type-unboxer-quot unboxer-quot>> ;
+
 : if-value-struct ( ctype true false -- )
     [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
 
@@ -40,7 +44,10 @@ M: struct-type stack-size
 
 : (define-struct) ( name size align fields -- )
     [ [ align ] keep ] dip
-    struct-type boa
+    struct-type new
+    swap >>fields
+    swap >>align
+    swap >>size
     swap typedef ;
 
 : make-fields ( name vocab fields -- fields )

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 71d9c3641228cd5a188dd9b9c1395b9b9b3c093b..d915b29ae56834b020c246983bb6b8831e6508ca 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -3,8 +3,8 @@
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays sets libc continuations.private
-fry cpu.architecture
+alien.strings alien.arrays alien.complex sets libc
+continuations.private fry cpu.architecture
 compiler.errors
 compiler.alien
 compiler.cfg

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 1b21e40bace1c762d5dd211f8ccebc53a6719f3d..b1a9853d553fc52e713298ff288f8b0de6f5ffa8 100644 (file)
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -558,3 +558,10 @@ FUNCTION: test_struct_14 ffi_test_44 ( ) ; inline
 : stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
 
 [ ] [ stack-frame-bustage 2drop ] unit-test
+
+FUNCTION: complex-float ffi_test_45 ( complex-float x, complex-double y ) ;
+
+[ C{ 4.0 4.0 } ] [
+    C{ 1.0 2.0 }
+    C{ 1.5 1.0 } ffi_test_45
+] unit-test
\ No newline at end of file

diff --git a/vm/ffi_test.c b/vm/ffi_test.c
index 1ec41ac2b937ea94e4d830dbdfd9a7766f5c1b88..36147795d13bb56c0a51dba6e68c69e2d6c6169a 100755 (executable)
--- a/vm/ffi_test.c
+++ b/vm/ffi_test.c
@@ -1,6 +1,5 @@
 /* This file is linked into the runtime for the sole purpose
  * of testing FFI code. */
-#include <stdio.h>
 #include "master.h"
 #include "ffi_test.h"
 
@@ -303,3 +302,8 @@ struct test_struct_14 ffi_test_44(void)
        retval.x2 = 2.0;
        return retval;
 }
+
+complex float ffi_test_45(complex float x, complex double y)
+{
+       return x + 2 * y;
+}

diff --git a/vm/ffi_test.h b/vm/ffi_test.h
index 7c51261157628f8f08427d0ab5306c370c8b6301..de48d6dc5b5bbbd76f29295175aa5b02c15e13a7 100755 (executable)
--- a/vm/ffi_test.h
+++ b/vm/ffi_test.h
@@ -88,3 +88,5 @@ struct test_struct_16 { float x; int a; };
 DLLEXPORT struct test_struct_16 ffi_test_43(float x, int a);
 
 DLLEXPORT struct test_struct_14 ffi_test_44();
+
+complex float ffi_test_45(complex float x, complex double y);

diff --git a/vm/master.h b/vm/master.h
index 86b5223eaa51e6038efdc0a85828044af9033714..01b2335841cad4bba7a24f74607b77040a8a4d88 100644 (file)
--- a/vm/master.h
+++ b/vm/master.h
@@ -8,6 +8,7 @@
 #include <fcntl.h>
 #include <limits.h>
 #include <math.h>
+#include <complex.h>
 #include <stdbool.h>
 #include <setjmp.h>