alien-indirect now works on PowerPC; changed callback tests to use it and removed some test functions from runtime

TODO.FACTOR.txt

@@ -32,6 +32,8 @@
 - doc sweep
 - tool help
 - perhaps commands window should sort by gesture
+- merge keyboard help with help in some way
+- keyboard help: hide commands whose gestures are shadowed
 
 + ui:
 
@@ -41,8 +43,6 @@
 - x11: scroll up/down wiggles caret
 - roundoff is still not quite right with tracks
 - fix top level window positioning
-- merge keyboard help with help in some way
-- keyboard help: hide commands whose gestures are shadowed
 - x11.app has a problem with A+ keys
 - status bar showing number of words needing a recompile
 - services do not launch if factor not running

library/compiler/alien/alien-indirect.factor

@@ -33,10 +33,9 @@ M: alien-indirect-error summary
         alien-indirect-parameters stack-space %cleanup
     ] if ;
 
-: %shuffle "shuffle" word-prop phantom-shuffle end-basic-block ;
-
 M: alien-indirect generate-node
     end-basic-block compile-gc
+    %prepare-alien-indirect
     dup alien-indirect-parameters objects>registers
     %alien-indirect
     dup generate-indirect-cleanup

library/compiler/alien/alien-invoke.factor

@@ -49,7 +49,8 @@ M: alien-invoke-error summary
     #! code for moving these parameters to register on
     #! architectures where parameters are passed in registers
     #! (PowerPC, AMD64).
-    dup unbox-parameters "save_stacks" f %alien-invoke
+    dup unbox-parameters
+    "save_stacks" f %alien-invoke
     \ %stack>freg move-parameters ;
 
 : box-return ( ctype -- )

library/compiler/generator/architecture.factor

@@ -112,6 +112,8 @@ DEFER: %alien-callback ( quot -- )
 
 DEFER: %callback-value ( reg-class func -- )
 
+DEFER: %prepare-alien-indirect ( -- )
+
 DEFER: %alien-indirect ( -- )
 
 M: stack-params fastcall-regs drop 0 ;

library/compiler/ppc/architecture.factor

@@ -195,8 +195,15 @@ M: stack-params %freg>stack
 : %alien-callback ( quot -- )
     0 <int-vreg> load-literal "run_callback" f %alien-invoke ;
 
+: %prepare-alien-indirect ( -- )
+    "unbox_alien" f %alien-invoke
+    "alien_temp" f 12 compile-dlsym
+    3 12 0 STW ;
+
 : %alien-indirect ( -- )
-    "unbox_alien" f %alien-invoke  3 MTLR BLRL ;
+    "alien_temp" f 12 compile-dlsym
+    12 12 0 LWZ
+    12 MTLR BLRL ;
 
 : save-return 0 swap [ return-reg ] keep %freg>stack ;
 : load-return 0 swap [ return-reg ] keep %stack>freg ;

library/compiler/test/callbacks.factor

@@ -1,6 +1,6 @@
 IN: temporary
-USING: alien compiler errors inference io kernel kernel-internals
-math memory namespaces test threads ;
+USING: alien compiler errors inference io kernel
+kernel-internals math memory namespaces test threads ;
 
 : callback-1 "void" { } [ ] alien-callback ;
 
@@ -8,7 +8,7 @@ math memory namespaces test threads ;
 
 [ t ] [ callback-1 alien? ] unit-test
 
-FUNCTION: void callback_test_1 void* callback ;
+: callback_test_1 "void" { } "cdecl" alien-indirect ;
 
 [ ] [ callback-1 callback_test_1 ] unit-test
 
@@ -57,11 +57,12 @@ FUNCTION: void callback_test_1 void* callback ;
     "void" { "int" "int" } [ / "x" set ] alien-callback ;
    
 
-FUNCTION: void callback_test_2 void* callback int x int y ;
+: callback_test_2
+    "void" { "int" "int" } "cdecl" alien-indirect ;
 
 [ 3/4 ] [
     [
-        "x" off callback-8 3 4 callback_test_2 "x" get
+        "x" off 3 4 callback-8 callback_test_2 "x" get
     ] with-scope
 ] unit-test
 
@@ -69,29 +70,30 @@ FUNCTION: void callback_test_2 void* callback int x int y ;
     "void" { "int" "double" "int" }
     [ + * "x" set ] alien-callback ;
 
-FUNCTION: void callback_test_3 void* callback int x double y int z ;
+: callback_test_3
+    "void" { "int" "double" "int" } "cdecl" alien-indirect ;
 
 [ 27.0 ] [
     [
-        "x" off callback-9 3 4 5 callback_test_3 "x" get
+        "x" off 3 4 5 callback-9 callback_test_3 "x" get
     ] with-scope
 ] unit-test
 
 : callback-11 "int" { } [ 1234 ] alien-callback ;
 
-FUNCTION: int callback_test_5 void* callback ;
+: callback_test_5 "int" { } "cdecl" alien-indirect ;
 
 [ 1234 ] [ callback-11 callback_test_5 ] unit-test
 
 : callback-12 "float" { } [ pi ] alien-callback ;
 
-FUNCTION: float callback_test_6 void* callback ;
+: callback_test_6 "float" { } "cdecl" alien-indirect ;
 
 [ t ] [ callback-12 callback_test_6 pi - 0.00001 <= ] unit-test
 
 : callback-13 "double" { } [ pi ] alien-callback ;
 
-FUNCTION: double callback_test_7 void* callback ;
+: callback_test_7 "double" { } "cdecl" alien-indirect ;
 
 [ t ] [ callback-13 callback_test_7 pi = ] unit-test
 
@@ -100,11 +102,15 @@ FUNCTION: double callback_test_7 void* callback ;
     { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" }
     [ datastack "stack" set ] alien-callback ;
 
-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 ;
+: callback_test_4
+    "void"
+    { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" }
+    "cdecl"
+    alien-indirect ;
 
 [ V{ 1 2 3 4 5 6 7 8 9 10 } ] [
     [
-        callback-10 1 2 3 4 5 6 7 8 9 10 callback_test_4
+        1 2 3 4 5 6 7 8 9 10 callback-10 callback_test_4
         "stack" get
     ] with-scope
 ] unit-test
@@ -122,6 +128,6 @@ END-STRUCT
     { "foo" }
     [ dup foo-x swap foo-y / ] alien-callback ;
 
-FUNCTION: int callback_test_8 void* callback foo x ;
+: callback_test_8 "int" { "foo" } "cdecl" alien-indirect ;
 
-[ 5 ] [ callback-14 10 2 make-foo callback_test_8 ] unit-test
+[ 5 ] [ 10 2 make-foo callback-14 callback_test_8 ] unit-test

vm/alien.h

@@ -1,3 +1,5 @@
+DLLEXPORT CELL alien_temp;
+
 INLINE ALIEN* untag_alien_fast(CELL tagged)
 {
 	return (ALIEN*)UNTAG(tagged);

vm/ffi_test.c

@@ -93,76 +93,3 @@ struct foo ffi_test_14(int x, int y)
 	r.x = x; r.y = y;
 	return r;
 }
-
-void callback_test_1(void (*callback)(void))
-{
-	printf("callback_test_1 entry\n");
-	fflush(stdout);
-	callback();
-	printf("callback_test_1 leaving\n");
-	fflush(stdout);
-}
-
-void callback_test_2(void (*callback)(int x, int y), int x, int y)
-{
-	printf("callback_test_2 entry\n");
-	fflush(stdout);
-	callback(x,y);
-	printf("callback_test_2 leaving\n");
-	fflush(stdout);
-}
-
-void callback_test_3(void (*callback)(int x, double y, int z),
-	int x, double y, int z)
-{
-	printf("callback_test_3 entry\n");
-	fflush(stdout);
-	callback(x,y,z);
-	printf("callback_test_3 leaving\n");
-	fflush(stdout);
-}
-
-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), int a1, int a2, int a3, int a4, int a5, int a6, int a7, int a8, int a9, int a10)
-{
-	printf("callback_test_4 entry\n");
-	fflush(stdout);
-	callback(a1,a2,a3,a4,a5,a6,a7,a8,a9,a10);
-	printf("callback_test_4 leaving\n");
-	fflush(stdout);
-}
-
-int callback_test_5(int (*callback)(void))
-{
-	int x;
-	printf("callback_test_5 entry\n");
-	x = callback();
-	printf("callback_test_5 exit\n");
-	return x;
-}
-
-float callback_test_6(float (*callback)(void))
-{
-	float x;
-	printf("callback_test_6 entry\n");
-	x = callback();
-	printf("callback_test_6 exit\n");
-	return x;
-}
-
-double callback_test_7(double (*callback)(void))
-{
-	double x;
-	printf("callback_test_7 entry\n");
-	x = callback();
-	printf("callback_test_7 exit\n");
-	return x;
-}
-
-int callback_test_8(int (*callback)(struct foo x), struct foo x)
-{
-	int y;
-	printf("callback_test_8(foo.x=%d,foo.y=%d) entry\n",x.x,x.y);
-	y = callback(x);
-	printf("callback_test_8 exit\n");
-	return y;
-}

vm/ffi_test.h

@@ -15,11 +15,3 @@ struct rect { float x, y, w, h; };
 DLLEXPORT int ffi_test_12(int a, int b, struct rect c, int d, int e, int f);
 DLLEXPORT 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);
 DLLEXPORT struct foo ffi_test_14(int x, int y);
-DLLEXPORT void callback_test_1(void (*callback)(void));
-DLLEXPORT void callback_test_2(void (*callback)(int x, int y), int x, int y);
-DLLEXPORT void callback_test_3(void (*callback)(int x, double y, int z), int x, double y, int z);
-DLLEXPORT 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), int a1, int a2, int a3, int a4, int a5, int a6, int a7, int a8, int a9, int a10);
-DLLEXPORT int callback_test_5(int (*callback)(void));
-DLLEXPORT float callback_test_6(float (*callback)(void));
-DLLEXPORT double callback_test_7(double (*callback)(void));
-DLLEXPORT int callback_test_8(int (*callback)(struct foo x), struct foo x);