diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 3e4f149077..7edb840226 100644 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -2,7 +2,7 @@ USING: accessors alien alien.c-types alien.complex alien.data alien.libraries alien.syntax arrays byte-arrays classes classes.struct combinators combinators.extras compiler compiler.test concurrency.promises continuations destructors effects generalizations io io.backend io.pathnames -io.streams.string kernel kernel.private libc layouts math math.bitwise +io.streams.string kernel kernel.private libc layouts locals math math.bitwise math.private memory namespaces namespaces.private random parser quotations sequences slots.private specialized-arrays stack-checker stack-checker.errors system threads tools.test words ; @@ -963,3 +963,117 @@ FUNCTION: void* bug1021_test_3 ( c-string a ) { } [ 10000 [ 0 doit 33 assert= ] times ] unit-test + +! Tests for System V AMD64 ABI +STRUCT: test_struct_66 { mem1 ulong } { mem2 ulong } ; +STRUCT: test_struct_68 { mem1 ulong } { mem2 ulong } { mem3 ulong } ; +STRUCT: test_struct_69 { mem1 float } { mem2 ulong } { mem3 ulong } ; +FUNCTION: ulong ffi_test_66 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e ) +FUNCTION: ulong ffi_test_67 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_66 e ulong _f ) +FUNCTION: ulong ffi_test_68 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_68 e test_struct_66 _f ) +FUNCTION: ulong ffi_test_69 ( ulong a, ulong b, ulong c, test_struct_66 d, test_struct_69 e test_struct_66 _f ) +FUNCTION: ulong ffi_test_70 ( test_struct_68 a test_struct_68 b, test_struct_66 c ) + +{ 28 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } ffi_test_66 ] unit-test + +: callback-14 ( -- callback ) + ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl + [| a b c d e | + a b + c + + d [ mem1>> + ] [ mem2>> + ] bi + e [ mem1>> + ] [ mem2>> + ] bi + ] alien-callback ; + +: callback-14-test ( a b c d e callback -- result ) + ulong { ulong ulong ulong test_struct_66 test_struct_66 } cdecl alien-indirect ; + +{ 28 } [ + 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } callback-14 [ + callback-14-test + ] with-callback +] unit-test + +{ 44 } [ 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 ffi_test_67 ] unit-test + +: callback-15 ( -- callback ) + ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl + [| a b c d e _f | + a b + c + + d [ mem1>> + ] [ mem2>> + ] bi + e [ mem1>> + ] [ mem2>> + ] bi + _f 2 * + + ] alien-callback ; + +: callback-15-test ( a b c d e _f callback -- result ) + ulong { ulong ulong ulong test_struct_66 test_struct_66 ulong } cdecl alien-indirect ; + +{ 44 } [ + 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_66 f 6 7 } 8 callback-15 [ + callback-15-test + ] with-callback +] unit-test + +{ 55 } [ + 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } ffi_test_68 +] unit-test + +: callback-16 ( -- callback ) + ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl + [| a b c d e _f | + a b + c + + d [ mem1>> + ] [ mem2>> + ] bi + e [ mem1>> + ] [ mem2>> + ] [ mem3>> + ] tri + _f [ mem1>> + ] [ mem2>> + ] bi + ] alien-callback ; + +: callback-16-test ( a b c d e _f callback -- result ) + ulong { ulong ulong ulong test_struct_66 test_struct_68 test_struct_66 } cdecl alien-indirect ; + +{ 55 } [ + 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_68 f 6 7 8 } S{ test_struct_66 f 9 10 } callback-16 [ + callback-16-test + ] with-callback +] unit-test + +{ 55 } [ + 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_69 f 6.0 7 8 } S{ test_struct_66 f 9 10 } ffi_test_69 +] unit-test + +: callback-17 ( -- callback ) + ulong { ulong ulong ulong test_struct_66 test_struct_69 test_struct_66 } cdecl + [| a b c d e _f | + a b + c + + d [ mem1>> + ] [ mem2>> + ] bi + e [ mem1>> >integer + ] [ mem2>> + ] [ mem3>> + ] tri + _f [ mem1>> + ] [ mem2>> + ] bi + ] alien-callback ; + +: callback-17-test ( a b c d e _f callback -- result ) + ulong { ulong ulong ulong test_struct_66 test_struct_69 test_struct_66 } cdecl alien-indirect ; + +{ 55 } [ + 1 2 3 S{ test_struct_66 f 4 5 } S{ test_struct_69 f 6.0 7 8 } S{ test_struct_66 f 9 10 } callback-17 [ + callback-17-test + ] with-callback +] unit-test + +{ 36 } [ + S{ test_struct_68 f 1 2 3 } S{ test_struct_68 f 4 5 6 } S{ test_struct_66 f 7 8 } ffi_test_70 +] unit-test + +: callback-18 ( -- callback ) + ulong { test_struct_68 test_struct_68 test_struct_66 } cdecl + [| a b c | + a [ mem1>> ] [ mem2>> + ] [ mem3>> + ] tri + b [ mem1>> + ] [ mem2>> + ] [ mem3>> + ] tri + c [ mem1>> + ] [ mem2>> + ] bi + ] alien-callback ; + +: callback-18-test ( a b c callback -- result ) + ulong { test_struct_68 test_struct_68 test_struct_66 } cdecl alien-indirect ; + +{ 36 } [ + S{ test_struct_68 f 1 2 3 } S{ test_struct_68 f 4 5 6 } S{ test_struct_66 f 7 8 } callback-18 [ + callback-18-test + ] with-callback +] unit-test diff --git a/vm/ffi_test.c b/vm/ffi_test.c index 1927a8d988..7e927b9d27 100644 --- a/vm/ffi_test.c +++ b/vm/ffi_test.c @@ -357,6 +357,41 @@ double ffi_test_65(int n, ...) { return sum; } +unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_66 e) { + unsigned long x; + x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2; + return x; +} + +unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_66 e, + unsigned long f) { + unsigned long x; + x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + f*2; + return x; +} + +unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f) { + unsigned long x; + x = a + b + c + d.mem1 + d.mem2 + e.mem1 + e.mem2 + e.mem3 + f.mem1 + f.mem2; + return x; +} + +unsigned long ffi_test_69(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_69 e, struct test_struct_66 f) { + unsigned long x; + x = a + b + c + d.mem1 + d.mem2 + (long)e.mem1 + e.mem2 + e.mem3 + f.mem1 + f.mem2; + return x; +} + +unsigned long ffi_test_70(struct test_struct_68 a, struct test_struct_68 b, struct test_struct_66 c) { + unsigned long x; + x = a.mem1 + a.mem2 + a.mem3 + b.mem1 + b.mem2 + b.mem3 + c.mem1 + c.mem2; + return x; +} + void* bug1021_test_1(void* x, int y) { return (void*)(y * y + (size_t)x); diff --git a/vm/ffi_test.def b/vm/ffi_test.def index fd5ff7b27e..4602bf92c4 100644 --- a/vm/ffi_test.def +++ b/vm/ffi_test.def @@ -1,5 +1,5 @@ EXPORTS - ffi_test_0 + ffi_test_0 ffi_test_1 ffi_test_2 ffi_test_3 @@ -46,7 +46,7 @@ EXPORTS ffi_test_42 ffi_test_43 ffi_test_44 - ffi_test_49 + ffi_test_49 ffi_test_50 ffi_test_51 ffi_test_52 @@ -62,6 +62,11 @@ EXPORTS ffi_test_63 ffi_test_64 ffi_test_65 + ffi_test_66 + ffi_test_67 + ffi_test_68 + ffi_test_69 + ffi_test_70 bug1021_test_1 bug1021_test_2 bug1021_test_3 diff --git a/vm/ffi_test.h b/vm/ffi_test.h index 1c7ae7ddb3..0a78885f03 100644 --- a/vm/ffi_test.h +++ b/vm/ffi_test.h @@ -232,6 +232,39 @@ FACTOR_EXPORT struct ulonglong_pair ffi_test_63(void); FACTOR_EXPORT int ffi_test_64(int n, ...); FACTOR_EXPORT double ffi_test_65(int n, ...); + +struct test_struct_66 { + unsigned long mem1; + unsigned long mem2; +}; + +struct test_struct_68 { + unsigned long mem1; + unsigned long mem2; + unsigned long mem3; +}; + +struct test_struct_69 { + float mem1; + unsigned long mem2; + unsigned long mem3; +}; + +FACTOR_EXPORT unsigned long ffi_test_66(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_66 e); + +FACTOR_EXPORT unsigned long ffi_test_67(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_66 e, unsigned long f); + +FACTOR_EXPORT unsigned long ffi_test_68(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_68 e, struct test_struct_66 f); + +FACTOR_EXPORT unsigned long ffi_test_69(unsigned long a, unsigned long b, unsigned long c, + struct test_struct_66 d, struct test_struct_69 e, struct test_struct_66 f); + +FACTOR_EXPORT unsigned long ffi_test_70(struct test_struct_68 a, struct test_struct_68 b, struct test_struct_66 c); + + FACTOR_EXPORT void* bug1021_test_1(void* x, int y); FACTOR_EXPORT int bug1021_test_2(int x, char* y, void *z); FACTOR_EXPORT void* bug1021_test_3(int x);