Fix callbacks with lots of parameters

TODO.FACTOR.txt

@@ -40,6 +40,7 @@
 
 + compiler/ffi:
 
+- x86 SIB addressing modes
 - amd64 %unbox-struct
 - float intrinsics
 - complex float type

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 ;
 

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 ;

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 -- )
+: map-parameters ( parameters quot -- seq )
-    >r [ parameter-sizes ] keep r> 2each ; inline
+    >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
+        [ pick >r alloc-parameter r> execute ] map-parameters
-        drop
+        nip
     ] with-scope ; inline
 
 : box-parameter ( stack# type -- node )

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

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

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 <rect> 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

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 } ] [

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");