steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
sheeple 2009-03-30 07:19:14 -05:00
parent 2ced468927
commit 42d164db77
3 changed files with 47 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
basis/cpu/ppc/ppc.factor
View File

@ -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 return-struct-in-registers? ( c-type -- ? )
c-type return-in-registers?>> ;
M: ppc %box-small-struct
drop "No small structs" throw ;
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 ;
M: ppc %unbox-small-struct
drop "No small structs" throw ;
: %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

13
vm/alien.c
View File

@ -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)
{

1
vm/alien.h
View File

@ -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)