From 06218d5d12b107ff2578f9797e750c595b1f33f9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 2 Oct 2011 19:52:02 -0700
Subject: [PATCH] compiler.cfg.builder.alien: fix compilation of callbacks
which unconditionally throw errors
---
basis/compiler/cfg/builder/alien/alien.factor | 7 +++++--
basis/compiler/tests/alien.factor | 4 ++++
2 files changed, 9 insertions(+), 2 deletions(-)
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 ;