compiler.cfg.builder.alien: fix compilation of callbacks which unconditionally throw errors
parent
83b11b401f
commit
06218d5d12
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue