alien-callback and alien-indirect now call the prep quotation

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index d5509ce2057f5d557acbc63d27a0e939ffbac4ce..3efdb105bc25a9e1c372dd4aa56343a9a858e2b1 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -5,7 +5,6 @@
 
 + ui:
 
-- input operation: copy
 - doc/handbook/alien.facts formatting wrong (erg)
 - docs: mention that 'like' may destroy the underlying sequence
 - live search: timer delay would be nice

diff --git a/library/compiler/alien/alien-callback.factor b/library/compiler/alien/alien-callback.factor
index 52f5435ff3c0c04f6b96b0c1ea4f4cc32f7e6a54..ef420050c53ea6652827ab2683e1df82b801570a 100644 (file)
--- a/library/compiler/alien/alien-callback.factor
+++ b/library/compiler/alien/alien-callback.factor
@@ -54,11 +54,18 @@ M: alien-callback-error summary
         %callback-value
     ] if-void ;
 
+: alien-callback-quot* ( node -- quot )
+    [
+        \ init-error-handler ,
+        dup alien-callback-quot %
+        alien-callback-return
+        [ ] [ c-type c-type-prep % ] if-void
+    ] [ ] make ;
+
 : generate-callback ( node -- )
     [ alien-callback-xt ] keep [
         dup alien-callback-parameters registers>objects
-        dup alien-callback-quot \ init-error-handler add*
-        %alien-callback
+        dup alien-callback-quot* %alien-callback
         unbox-return
         %return
     ] generate-1 ;

diff --git a/library/compiler/alien/alien-indirect.factor b/library/compiler/alien/alien-indirect.factor
index 7cfd0102ef5405b480d6e17a9d3930b0379d8fd8..2c0dfc6e4794dd92c9ae3d97c81b2968ee1418ce 100644 (file)
--- a/library/compiler/alien/alien-indirect.factor
+++ b/library/compiler/alien/alien-indirect.factor
@@ -19,10 +19,12 @@ M: alien-indirect-error summary
 "infer-effect" set-word-prop
 
 \ alien-indirect [
-    empty-node <alien-indirect> dup node,
+    empty-node <alien-indirect>
     pop-literal nip over set-alien-indirect-abi
     pop-literal nip over set-alien-indirect-parameters
     pop-literal nip swap set-alien-indirect-return
+    dup alien-indirect-parameters prep-alien-parameters
+    dup node,
 ] "infer" set-word-prop
 
 : generate-indirect-cleanup ( node -- )

diff --git a/library/compiler/alien/alien-invoke.factor b/library/compiler/alien/alien-invoke.factor
index 92621585645cb172897db95d13f4711e3c43432a..2e6f042aa81877863f804257cb35e3841ea52687 100644 (file)
--- a/library/compiler/alien/alien-invoke.factor
+++ b/library/compiler/alien/alien-invoke.factor
@@ -28,20 +28,6 @@ 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
 
@@ -51,7 +37,7 @@ M: alien-invoke-error summary
     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 alien-invoke-parameters prep-alien-parameters
     dup ensure-dlsym
     dup node,
     alien-invoke-stack

diff --git a/library/compiler/alien/compiler.factor b/library/compiler/alien/compiler.factor
index 34b46bd8761afe17311e68fc850759ca06458848..3acc2ab325d265afe4b441c341a2479de7904cfc 100644 (file)
--- a/library/compiler/alien/compiler.factor
+++ b/library/compiler/alien/compiler.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: alien
 USING: arrays compiler generic hashtables kernel
-kernel-internals math namespaces sequences words ;
+kernel-internals math namespaces sequences words
+inference ;
 
 : parameter-size c-size cell align ;
 
@@ -57,3 +58,14 @@ kernel-internals math namespaces sequences words ;
 
 : if-void ( type true false -- )
     pick "void" = [ drop nip call ] [ nip call ] if ; inline
+
+: make-prep-quot ( parameters -- )
+    dup empty? [
+        drop
+    ] [
+        unclip c-type c-type-prep %
+        \ >r , make-prep-quot \ r> ,
+    ] if ;
+
+: prep-alien-parameters ( parameters -- quot )
+    [ <reversed> make-prep-quot ] [ ] make infer-quot ;

diff --git a/library/compiler/alien/primitive-types.factor b/library/compiler/alien/primitive-types.factor
index db2defb69efd567ac629444a41f689bed3ac428b..aa9588ce88030f07cfcc6dc3ce3e8716baf3fb49 100644 (file)
--- a/library/compiler/alien/primitive-types.factor
+++ b/library/compiler/alien/primitive-types.factor
@@ -85,7 +85,7 @@ bootstrap-cell
 "bool" define-primitive-type
 
 [ alien-float ]
-[ set-alien-float ]
+[ >r >r >float r> r> set-alien-float ]
 4
 "box_float"
 "unbox_float"
@@ -95,7 +95,7 @@ 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 ]
+[ >r >r >float r> r> set-alien-double ]
 8
 "box_double"
 "unbox_double"

diff --git a/library/compiler/test/alien-objects.factor b/library/compiler/test/alien-objects.factor
index 07b9fcb03601cc7e318b333f5283634d76040749..a41eb8ad21ce7e33fe378677fce1263fb6c91240 100644 (file)
--- a/library/compiler/test/alien-objects.factor
+++ b/library/compiler/test/alien-objects.factor
@@ -1,5 +1,6 @@
 IN: temporary
-USING: alien arrays kernel kernel-internals namespaces test ;
+USING: alien arrays kernel kernel-internals namespaces test
+errors sequences ;
 
 [ t ] [ 0 <alien> 0 <alien> = ] unit-test
 [ f ] [ 0 <alien> 1024 <alien> = ] unit-test