diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index d5509ce205..3efdb105bc 100644 --- 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 52f5435ff3..ef420050c5 100644 --- 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 7cfd0102ef..2c0dfc6e47 100644 --- 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 dup node, + empty-node 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 9262158564..2e6f042aa8 100644 --- 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 ) - [ (make-prep-quot) ] [ ] make ; - -: prep-alien-invoke ( node -- ) - alien-invoke-parameters make-prep-quot infer-quot ; - \ alien-invoke [ string object string object ] [ ] "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 34b46bd876..3acc2ab325 100644 --- 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 ) + [ make-prep-quot ] [ ] make infer-quot ; diff --git a/library/compiler/alien/primitive-types.factor b/library/compiler/alien/primitive-types.factor index db2defb69e..aa9588ce88 100644 --- 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 07b9fcb036..a41eb8ad21 100644 --- 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 0 = ] unit-test [ f ] [ 0 1024 = ] unit-test