Fix C99 complex number support in FFI on Mac OS X/PPC

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 8b6b4fbb11cc356e09426134ce71c28ad975df78..85bf188bb81298731d3bdf46f9575ffaa85ce836 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -659,13 +659,40 @@ M: ppc %callback-value ( ctype -- )
 
 M: ppc small-enough? ( n -- ? ) -32768 32767 between? ;
 
-M: ppc return-struct-in-registers? ( c-type -- ? ) drop f ;
-
-M: ppc %box-small-struct
-    drop "No small structs" throw ;
-
-M: ppc %unbox-small-struct
-    drop "No small structs" throw ;
+M: ppc return-struct-in-registers? ( c-type -- ? )
+    c-type return-in-registers?>> ;
+
+M: ppc %box-small-struct ( c-type -- )
+    #! Box a <= 16-byte struct returned in r3:r4:r5:r6
+    heap-size 7 LI
+    "box_medium_struct" f %alien-invoke ;
+
+: %unbox-struct-1 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    3 3 0 LWZ ;
+
+: %unbox-struct-2 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    4 3 4 LWZ
+    3 3 0 LWZ ;
+
+: %unbox-struct-4 ( -- )
+    ! Alien must be in r3.
+    "alien_offset" f %alien-invoke
+    6 3 12 LWZ
+    5 3 8 LWZ
+    4 3 4 LWZ
+    3 3 0 LWZ ;
+
+M: ppc %unbox-small-struct ( size -- )
+    #! Alien must be in EAX.
+    heap-size cell align cell /i {
+        { 1 [ %unbox-struct-1 ] }
+        { 2 [ %unbox-struct-2 ] }
+        { 4 [ %unbox-struct-4 ] }
+    } case ;
 
 USE: vocabs.loader
 
@@ -673,3 +700,5 @@ USE: vocabs.loader
     { [ os macosx? ] [ "cpu.ppc.macosx" require ] }
     { [ os linux? ] [ "cpu.ppc.linux" require ] }
 } cond
+
+"complex-double" c-type t >>return-in-registers? drop

diff --git a/vm/alien.c b/vm/alien.c
index 8b7df45e9ada4bb060c01020064ce178bdb4a3c9..2681579c5d47005f241a3bc4284c632349d83a3b 100755 (executable)
--- a/vm/alien.c
+++ b/vm/alien.c
@@ -160,7 +160,7 @@ void box_value_struct(void *src, CELL size)
        dpush(tag_object(array));
 }
 
-/* On OS X, structs <= 8 bytes are returned in registers. */
+/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
 void box_small_struct(CELL x, CELL y, CELL size)
 {
        CELL data[2];
@@ -169,6 +169,17 @@ void box_small_struct(CELL x, CELL y, CELL size)
        box_value_struct(data,size);
 }
 
+/* On OS X/PPC, complex numbers are returned in registers. */
+void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size)
+{
+       CELL data[4];
+       data[0] = x1;
+       data[1] = x2;
+       data[2] = x3;
+       data[3] = x4;
+       box_value_struct(data,size);
+}
+
 /* open a native library and push a handle */
 void primitive_dlopen(void)
 {

diff --git a/vm/alien.h b/vm/alien.h
index ec1eb08acf9fcaece8760195883d4bfa4003c8b0..dc76d49810c422740393919014ddb02aa55c4c5a 100755 (executable)
--- a/vm/alien.h
+++ b/vm/alien.h
@@ -40,6 +40,7 @@ void primitive_set_alien_cell(void);
 DLLEXPORT void to_value_struct(CELL src, void *dest, CELL size);
 DLLEXPORT void box_value_struct(void *src, CELL size);
 DLLEXPORT void box_small_struct(CELL x, CELL y, CELL size);
+void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size);
 
 DEFINE_UNTAG(F_DLL,DLL_TYPE,dll)