diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index ff7a2cdae2..dca9d01fa9 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -182,6 +182,9 @@ M: #alien-assembly emit-node : emit-callback-body ( nodes -- ) [ last #return? t assert= ] [ but-last emit-nodes ] bi ; +: emit-callback-return ( params -- ) + basic-block get [ callee-return ##callback-outputs ] [ drop ] if ; + M: #alien-callback emit-node dup params>> xt>> dup [ @@ -193,9 +196,9 @@ M: #alien-callback emit-node [ params>> callee-parameters ##callback-inputs ] [ params>> box-parameters ] [ child>> emit-callback-body ] - [ params>> callee-return ##callback-outputs ] + [ params>> emit-callback-return ] [ params>> callback-stack-cleanup ] } cleave - end-word + basic-block get [ end-word ] when ] with-cfg-builder ; diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index 6aa9cd8bce..feb18e0d7a 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -334,6 +334,10 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ; [ t ] [ 31 2^ 32 2^ ffi_test_38 63 2^ = ] unit-test ! Test callbacks +: callback-throws ( -- x ) + int { } cdecl [ "Hi" throw ] alien-callback ; + +[ t ] [ callback-throws alien? ] unit-test : callback-1 ( -- callback ) void { } cdecl [ ] alien-callback ;