alien-invoke no longer generates calls to consing unbox_* functions -- instead we...

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 040e4ef4c37ac94d91effc3091282a60ee4fcb49..d5509ce2057f5d557acbc63d27a0e939ffbac4ce 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/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:

diff --git a/library/compiler/alien/alien-invoke.factor b/library/compiler/alien/alien-invoke.factor
index d61092b335911297f8e7815ca91fb023acc57e82..92621585645cb172897db95d13f4711e3c43432a 100644 (file)
--- a/library/compiler/alien/alien-invoke.factor
+++ b/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
 

diff --git a/library/compiler/alien/primitive-types.factor b/library/compiler/alien/primitive-types.factor
index 99bb020db256a0916e421a68fd30a1203f6ea93c..db2defb69efd567ac629444a41f689bed3ac428b 100644 (file)
--- a/library/compiler/alien/primitive-types.factor
+++ b/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

diff --git a/library/compiler/test/alien.factor b/library/compiler/test/alien.factor
index fec2c8c4db527523ca7984746490ffad6bb79090..c7d417e107bef498a18da2249d1b3b744a2e37fe 100644 (file)
--- a/library/compiler/test/alien.factor
+++ b/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

diff --git a/vm/ffi_test.c b/vm/ffi_test.c
index 80d269f0c30e79af9b1fa6b4d3c58aac69eefcef..8e87b8fb6c2f0816006b9834859c997fbf90efc3 100644 (file)
--- a/vm/ffi_test.c
+++ b/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";
+}

diff --git a/vm/ffi_test.h b/vm/ffi_test.h
index c9aa16d6ab2c6b0610b1579bff3210ec6c87f43f..8991664526fe672a1721829dbcd5613ab034ed1f 100644 (file)
--- a/vm/ffi_test.h
+++ b/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);