alien-invoke no longer generates calls to consing unbox_* functions -- instead we just unbox the parameter list first, in factor code

TODO.FACTOR.txt

@@ -1,9 +1,6 @@
 + allot refactoring:
 
 - inline float allocation needs a gc check
-- fix alien invoke as required
-  - we can just convert strings to aliens beforehand
-  - >float first too
 - docs: don't pass volatile aliens to callbacks
 
 + ui:

library/compiler/alien/alien-invoke.factor

@@ -28,16 +28,32 @@ M: alien-invoke-error summary
     [ alien-invoke-dlsym dlsym drop ]
     [ inference-warning ] recover ;
 
+: (make-prep-quot) ( parameters -- )
+    dup empty? [
+        drop
+    ] [
+        unclip c-type c-type-prep %
+        \ >r , (make-prep-quot) \ r> ,
+    ] if ;
+
+: make-prep-quot ( parameters -- quot )
+    [ <reversed> (make-prep-quot) ] [ ] make ;
+
+: prep-alien-invoke ( node -- )
+    alien-invoke-parameters make-prep-quot infer-quot ;
+
 \ alien-invoke [ string object string object ] [ ] <effect>
 "infer-effect" set-word-prop
 
 \ alien-invoke [
-    empty-node <alien-invoke> dup node,
+    empty-node <alien-invoke>
     pop-literal nip over set-alien-invoke-parameters
     pop-literal nip over set-alien-invoke-function
     pop-literal nip over set-alien-invoke-library
     pop-literal nip over set-alien-invoke-return
+    dup prep-alien-invoke
     dup ensure-dlsym
+    dup node,
     alien-invoke-stack
 ] "infer" set-word-prop
 

library/compiler/alien/primitive-types.factor

@@ -7,7 +7,6 @@ bootstrap-cell
 "unbox_alien"
 "void*" define-primitive-type
 
-
 [ alien-signed-8 ]
 [ set-alien-signed-8 ]
 8
@@ -15,7 +14,6 @@ bootstrap-cell
 "unbox_signed_8"
 "longlong" define-primitive-type
 
-
 [ alien-unsigned-8 ]
 [ set-alien-unsigned-8 ]
 8
@@ -23,7 +21,6 @@ bootstrap-cell
 "unbox_unsigned_8"
 "ulonglong" define-primitive-type
 
-
 [ alien-signed-cell ]
 [ set-alien-signed-cell ]
 bootstrap-cell
@@ -31,7 +28,6 @@ bootstrap-cell
 "unbox_signed_cell"
 "long" define-primitive-type
 
-
 [ alien-unsigned-cell ]
 [ set-alien-unsigned-cell ]
 bootstrap-cell
@@ -39,7 +35,6 @@ bootstrap-cell
 "unbox_unsigned_cell"
 "ulong" define-primitive-type
 
-
 [ alien-signed-4 ]
 [ set-alien-signed-4 ]
 4
@@ -47,7 +42,6 @@ bootstrap-cell
 "unbox_signed_4"
 "int" define-primitive-type
 
-
 [ alien-unsigned-4 ]
 [ set-alien-unsigned-4 ]
 4
@@ -55,7 +49,6 @@ bootstrap-cell
 "unbox_unsigned_4"
 "uint" define-primitive-type
 
-
 [ alien-signed-2 ]
 [ set-alien-signed-2 ]
 2
@@ -63,7 +56,6 @@ bootstrap-cell
 "unbox_signed_2"
 "short" define-primitive-type
 
-
 [ alien-unsigned-2 ]
 [ set-alien-unsigned-2 ]
 2
@@ -71,7 +63,6 @@ bootstrap-cell
 "unbox_unsigned_2"
 "ushort" define-primitive-type
 
-
 [ alien-signed-1 ]
 [ set-alien-signed-1 ]
 1
@@ -79,7 +70,6 @@ bootstrap-cell
 "unbox_signed_1"
 "char" define-primitive-type
 
-
 [ alien-unsigned-1 ]
 [ set-alien-unsigned-1 ]
 1
@@ -87,23 +77,6 @@ bootstrap-cell
 "unbox_unsigned_1"
 "uchar" define-primitive-type
 
-
-[ alien-unsigned-cell <alien> alien>char-string ]
-[ >r >r alien-address r> r> set-alien-unsigned-cell ]
-bootstrap-cell
-"box_char_string"
-"unbox_char_string"
-"char*" define-primitive-type
-
-
-[ alien-unsigned-cell <alien> alien>u16-string ]
-[ >r >r alien-address r> r> set-alien-unsigned-cell ]
-4
-"box_u16_string"
-"unbox_u16_string"
-"ushort*" define-primitive-type
-
-
 [ alien-unsigned-4 zero? not ]
 [ 1 0 ? set-alien-unsigned-4 ]
 4
@@ -111,7 +84,6 @@ bootstrap-cell
 "unbox_boolean"
 "bool" define-primitive-type
 
-
 [ alien-float ]
 [ set-alien-float ]
 4
@@ -120,6 +92,7 @@ bootstrap-cell
 "float" define-primitive-type
 
 T{ float-regs f 4 } "float" c-type set-c-type-reg-class
+[ >float ] "float" c-type set-c-type-prep
 
 [ alien-double ]
 [ set-alien-double ]
@@ -129,3 +102,22 @@ T{ float-regs f 4 } "float" c-type set-c-type-reg-class
 "double" define-primitive-type
 
 T{ float-regs f 8 } "double" c-type set-c-type-reg-class
+[ >float ] "double" c-type set-c-type-prep
+
+[ alien-unsigned-cell <alien> alien>char-string ]
+[ >r >r alien-address r> r> set-alien-unsigned-cell ]
+bootstrap-cell
+"box_char_string"
+"unbox_alien"
+"char*" define-primitive-type
+
+[ string>char-alien ] "char*" c-type set-c-type-prep
+
+[ alien-unsigned-cell <alien> alien>u16-string ]
+[ >r >r alien-address r> r> set-alien-unsigned-cell ]
+4
+"box_u16_string"
+"unbox_alien"
+"ushort*" define-primitive-type
+
+[ string>u16-alien ] "ushort*" c-type set-c-type-prep

library/compiler/test/alien.factor

@@ -86,3 +86,8 @@ cpu "x86" = macosx? and [
 [ 5 ]
 [ 2 3 "ffi_test_2" f dlsym indirect-test-2 ]
 unit-test
+
+FUNCTION: char* ffi_test_15 char* x char* y ;
+
+[ "foo" ] [ "xy" "zt" ffi_test_15 ] unit-test
+[ "bar" ] [ "xy" "xy" ffi_test_15 ] unit-test

vm/ffi_test.c

@@ -93,3 +93,11 @@ struct foo ffi_test_14(int x, int y)
 	r.x = x; r.y = y;
 	return r;
 }
+
+char *ffi_test_15(char *x, char *y)
+{
+	if(strcmp(x,y))
+		return "foo";
+	else
+		return "bar";
+}

vm/ffi_test.h

@@ -15,3 +15,4 @@ 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 char *ffi_test_15(char *x, char *y);