diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 7a2813c0c3..1e626ae88e 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -40,6 +40,7 @@ + compiler/ffi: +- x86 SIB addressing modes - amd64 %unbox-struct - float intrinsics - complex float type diff --git a/library/alien/alien-callback.factor b/library/alien/alien-callback.factor index b187e645f7..9d8b261bf0 100644 --- a/library/alien/alien-callback.factor +++ b/library/alien/alien-callback.factor @@ -33,14 +33,11 @@ M: alien-callback-error summary ( error -- ) ] "infer" set-word-prop : box-parameters ( parameters -- ) - [ box-parameter , ] each-parameter ; + [ box-parameter ] map-parameters % ; : registers>objects ( parameters -- ) - #! The corresponding unnest_stacks() call is made by the - #! run_nullary_callback() and run_unary_callback() runtime - #! functions. dup stack-space %parameters , - dup \ %freg>stack move-parameters + dup \ %freg>stack move-parameters % "nest_stacks" f %alien-invoke , box-parameters ; diff --git a/library/alien/alien-invoke.factor b/library/alien/alien-invoke.factor index f3152e6724..7b8b880dc8 100644 --- a/library/alien/alien-invoke.factor +++ b/library/alien/alien-invoke.factor @@ -57,7 +57,7 @@ M: alien-invoke-error summary ( error -- ) dup stack-space %parameters , dup unbox-parameters "save_stacks" f %alien-invoke , - \ %stack>freg move-parameters ; + \ %stack>freg move-parameters % ; : box-return ( node -- ) alien-invoke-return [ ] [ f swap box-parameter , ] if-void ; diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index 5cddcadfaa..a26c590a6b 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -40,18 +40,18 @@ kernel-internals math namespaces sequences words ; >r [ parameter-sizes ] keep [ reverse-slice ] 2apply r> 2each ; inline -: each-parameter ( parameters quot -- ) - >r [ parameter-sizes ] keep r> 2each ; inline +: map-parameters ( parameters quot -- seq ) + >r [ parameter-sizes ] keep r> 2map ; inline -: move-parameters ( params vop -- ) +: move-parameters ( params vop -- seq ) #! Moves values from C stack to registers (if vop is #! %stack>freg) and registers to C stack (if vop is #! %freg>stack). swap [ flatten-value-types 0 { int-regs float-regs stack-params } [ set ] each-with - [ pick >r alloc-parameter r> execute , ] each-parameter - drop + [ pick >r alloc-parameter r> execute ] map-parameters + nip ] with-scope ; inline : box-parameter ( stack# type -- node ) diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor index ee052d358b..c7633834d0 100644 --- a/library/compiler/ppc/alien.factor +++ b/library/compiler/ppc/alien.factor @@ -20,9 +20,14 @@ M: float-regs freg>stack >r 1 rot stack@ r> STF ; M: float-regs stack>freg >r 1 rot stack@ r> LF ; M: stack-params stack>freg - drop >r 0 1 rot stack@ LWZ 0 1 r> stack@ STW ; + drop 2dup = [ + 2drop + ] [ + >r 0 1 rot stack@ LWZ 0 1 r> stack@ STW + ] if ; -M: stack-params freg>stack swapd stack>freg ; +M: stack-params freg>stack + >r stack-increment + swap r> stack>freg ; M: %unbox generate-node ( vop -- ) drop diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor index 066247c05f..2faf0054fb 100644 --- a/library/compiler/vops.factor +++ b/library/compiler/vops.factor @@ -35,12 +35,17 @@ GENERIC: inc-reg-class ( register-class -- ) M: int-regs reg-size drop cell ; -M: int-regs inc-reg-class class inc ; +: (inc-reg-class) + dup class inc + os "macosx" = [ reg-size stack-params +@ ] [ drop ] if ; + +M: int-regs inc-reg-class + (inc-reg-class) ; M: float-regs reg-size float-regs-size ; M: float-regs inc-reg-class - dup class inc + dup (inc-reg-class) os "macosx" = [ reg-size 4 / int-regs +@ ] [ drop ] if ; ! A pseudo-register class for parameters spilled on the stack diff --git a/library/test/compiler/alien.factor b/library/test/compiler/alien.factor index d83a983dfe..e40120fa15 100644 --- a/library/test/compiler/alien.factor +++ b/library/test/compiler/alien.factor @@ -63,3 +63,7 @@ END-STRUCT FUNCTION: int ffi_test_12 int a int b rect c int d int e int f ; compiled [ 45 ] [ 1 2 3 4 5 6 7 8 9 ffi_test_12 ] unit-test + +FUNCTION: int ffi_test_13 int a int b int c int d int e int f int g int h int i int j int k ; compiled + +[ 66 ] [ 1 2 3 4 5 6 7 8 9 10 11 ffi_test_13 ] unit-test diff --git a/library/test/compiler/callbacks.factor b/library/test/compiler/callbacks.factor index ea0245d9bb..7e43fc722b 100644 --- a/library/test/compiler/callbacks.factor +++ b/library/test/compiler/callbacks.factor @@ -78,11 +78,6 @@ FUNCTION: void callback_test_3 void* callback int x double y int z ; compiled ] with-scope ] unit-test -: callback-10 - "void" - { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" } - [ datastack "stack" set ] alien-callback ; compiled - : callback-11 "int" { } [ 1234 ] alien-callback ; compiled FUNCTION: int callback_test_5 void* callback ; compiled @@ -101,6 +96,11 @@ FUNCTION: double callback_test_7 void* callback ; compiled [ t ] [ callback-13 callback_test_7 pi = ] unit-test +: callback-10 + "void" + { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" } + [ datastack "stack" set ] alien-callback ; compiled + FUNCTION: void callback_test_4 void* callback int a1 int a2 int a3 int a4 int a5 int a6 int a7 int a8 int a9 int a10 ; compiled [ V{ 1 2 3 4 5 6 7 8 9 10 } ] [ diff --git a/native/ffi_test.c b/native/ffi_test.c index 6cdba28de9..f95c835c8f 100644 --- a/native/ffi_test.c +++ b/native/ffi_test.c @@ -81,6 +81,12 @@ int ffi_test_12(int a, int b, struct rect c, int d, int e, int f) return a + b + c.x + c.y + c.w + c.h + d + e + f; } +int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k) +{ + printf("ffi_test_13(%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d)\n",a,b,c,d,e,f,g,h,i,j,k); + return a + b + c + d + e + f + g + h + i + j + k; +} + void callback_test_1(void (*callback)(void)) { printf("callback_test_1 entry\n");