First of all, let me say that I like the new FFI (as
outlined in `A Primitive Foreign Function Interface') very
much :-) I really hope that this eventually makes it into
the Haskell standard - although, there are still some things
to smooth out.
Unfortunately, the implementation in GHC 4.01 is still a bit
buggy. Two bugs are reproduced by the following program
import Int (Int8, intToInt8, Int16, intToInt16, Int32, intToInt32,
Int64, intToInt64)
foreign import ccall "" "foo"
foo :: Int8 -> Int16 -> Int32 -> Int64 -> IO ()
--(2) foreign import ccall "" "bar" bar :: IO Int64
main = do
foo (intToInt8 8) (intToInt16 16) (intToInt32 32) (intToInt64 64)
--(2) _ <- bar
return ()
The first problem is that `Int8', `Int16', and `Int32' are
all implemented by the same C data type, namely the one
represented by `I_' in the HC file -- this makes all of them
32 bit `signed int' on my Pentium machine. The generated HC
code for the call to `foo' is
{
I_ _ccall_arg1=(I_)(*Sp);
I_ _ccall_arg2=(I_)(Sp[-2]);
I_ _ccall_arg3=(I_)(Sp[-1]);
LI_ _ccall_arg4=PK_Int64(R1.p+1);
do { SaveThreadState();
(foo((_ccall_arg1),(_ccall_arg2),(_ccall_arg3),(_ccall_arg4)));
LoadThreadState();} while(0);
}
I MIME attach the complete HC file.
The second problem occurs if you uncomment the lines marked
by `--(2)'. Then, the compiler dies with
CgHeapery.lhs:345: Non-exhaustive patterns in function mkRegLiveness
Hope this helps,
Manuel
SET_STATIC_HDR(Main_foo_closure,Main_foo_info,0,,EI_)
, {(L_)0}
};
INFO_TABLE_SRT_BITMAP(c1q8_info,c1q8_ret,0,0,0,0,RET_SMALL,static const,IF_,0,0);
IFN_(c1q8_ret) {
EC_(PrelBase_Z40Z41_static_closure);
FB_
R1.p=(P_)&PrelBase_Z40Z41_static_closure;
Sp=Sp+1;
JMP_(((P_)(*Sp)));
FE_
}
INFO_TABLE_SRT_BITMAP(c1q7_info,c1q7_ret,7,0,0,0,RET_SMALL,static const,IF_,0,0);
IFN_(c1q7_ret) {
FB_
Sp[3]=(W_)((P_)&c1q8_info);
Sp=Sp+3;
{
I_ _ccall_arg1=(I_)(*Sp);
I_ _ccall_arg2=(I_)(Sp[-2]);
I_ _ccall_arg3=(I_)(Sp[-1]);
LI_ _ccall_arg4=PK_Int64(R1.p+1);
do { SaveThreadState();
(foo((_ccall_arg1),(_ccall_arg2),(_ccall_arg3),(_ccall_arg4)));
LoadThreadState();} while(0);
}
JMP_(((P_)(*Sp)));
FE_
}
INFO_TABLE_SRT_BITMAP(c1q6_info,c1q6_ret,5,0,0,0,RET_SMALL,static const,IF_,0,0);
IFN_(c1q6_ret) {
P_ _f1vA_;
FB_
_f1vA_=(P_)(Sp[2]);
Sp[2]=(W_)(R1.p[1]);
R1.p=_f1vA_;
*Sp=(W_)((P_)&c1q7_info);
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT_BITMAP(c1q5_info,c1q5_ret,4,0,0,0,RET_SMALL,static const,IF_,0,0);
IFN_(c1q5_ret) {
P_ _f1vK_;
FB_
_f1vK_=(P_)(Sp[1]);
Sp[1]=(W_)(R1.p[1]);
R1.p=_f1vK_;
*Sp=(W_)((P_)&c1q6_info);
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT_BITMAP(c1q4_info,c1q4_ret,8,0,0,0,RET_SMALL,static const,IF_,0,0);
IFN_(c1q4_ret) {
FB_
Sp[4]=(W_)(R1.p[1]);
R1.p=(P_)(Sp[1]);
Sp[1]=(W_)((P_)&c1q5_info);
Sp=Sp+1;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE(Main_foo_info,Main_foo_entry,0,0,FUN_STATIC,const,EF_,0,0);
FN_(Main_foo_entry) {
EC_(Main_foo_closure);
EF_(Main_foo_fast5);
FB_
ARGS_CHK_LOAD_NODE(5,(P_)&Main_foo_closure);
R1.p=(P_)(*Sp);
Sp=Sp+1;
JMP_(Main_foo_fast5);
FE_
}
FN_(Main_foo_fast5) {
EF_(Main_foo_entry);
FB_
STK_CHK(1,Main_foo_entry,R2.p,1,Sp[3]=(W_)((W_) (ARG_TAG(0))););
Sp[-1]=(W_)((P_)&c1q4_info);
Sp=Sp-1;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
EC_(PrelIOBase__dMonadIO0_closure);
SRT(c1pO_srt)
&PrelIOBase__dMonadIO0_closure};
SET_STATIC_HDR(c1pO_closure,c1pO_info,0,static ,II_)
, {(L_)0, (L_)0, (L_)0}
};
INFO_TABLE_SRT_BITMAP(c1pY_info,c1pY_ret,0,0,0,0,RET_SMALL,static const,IF_,0,0);
IFN_(c1pY_ret) {
FB_
R1.p=(P_)(R1.p[1]);
Sp=Sp+1;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT(c1pO_info,c1pO_entry,0,2,c1pO_srt,0,1,THUNK_STATIC,static
const,IF_,0,0);
IFN_(c1pO_entry) {
EC_(PrelIOBase__dMonadIO0_closure);
FB_
HP_STK_CHK_NP(4,3,1,);
SET_HDR_(Hp-2,(P_)&BLACKHOLE_info,0);
UPD_CAF(R1.p,Hp-2);
PUSH_UPD_FRAME(Hp-2,0);
R1.p=(P_)&PrelIOBase__dMonadIO0_closure;
Sp[-4]=(W_)((P_)&c1pY_info);
Sp=Sp-4;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
EC_(Int_intToInt8_closure);
EC_(Int_intToInt16_closure);
EC_(Int_intToInt32_closure);
EC_(Int_intToInt64_closure);
IC_(c1pO_closure);
EC_(PrelIOBase__dMonadIO0_closure);
SRT(Main_main_srt)
&Int_intToInt8_closure,&Int_intToInt16_closure,&Int_intToInt32_closure,&Int_intToInt64_closure,&c1pO_closure,&PrelIOBase__dMonadIO0_closure};
SET_STATIC_HDR(Main_main_closure,Main_main_info,0,,EI_)
, {(L_)0, (L_)0, (L_)0}
};
INFO_TABLE_SRT(c1pL_info,c1pL_entry,0,2,Main_main_srt,0,1,THUNK,static const,IF_,0,0);
IFN_(c1pL_entry) {
EC_(Int_intToInt8_closure);
FB_
STK_CHK_NP(4,1,);
UPD_BH_UPDATABLE(R1.p);
PUSH_UPD_FRAME(R1.p,0);
Sp[-4]=(W_)(INTLIKE_CLOSURE(8));
R1.p=(P_)&Int_intToInt8_closure;
Sp=Sp-4;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT(c1pM_info,c1pM_entry,0,2,Main_main_srt,1,1,THUNK,static const,IF_,0,0);
IFN_(c1pM_entry) {
EC_(Int_intToInt16_closure);
FB_
STK_CHK_NP(4,1,);
UPD_BH_UPDATABLE(R1.p);
PUSH_UPD_FRAME(R1.p,0);
Sp[-4]=(W_)(INTLIKE_CLOSURE(16));
R1.p=(P_)&Int_intToInt16_closure;
Sp=Sp-4;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT(c1pR_info,c1pR_entry,0,2,Main_main_srt,2,1,THUNK,static const,IF_,0,0);
IFN_(c1pR_entry) {
EI_(PrelBase_IZh_con_info);
EC_(Int_intToInt32_closure);
FB_
HP_STK_CHK_NP(4,2,1,);
UPD_BH_UPDATABLE(R1.p);
PUSH_UPD_FRAME(R1.p,0);
SET_HDR_(Hp-1,(P_)&PrelBase_IZh_con_info,0);
*Hp=(W_)(32);
Sp[-4]=(W_)(Hp-1);
R1.p=(P_)&Int_intToInt32_closure;
Sp=Sp-4;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT(c1pT_info,c1pT_entry,0,2,Main_main_srt,3,1,THUNK,static const,IF_,0,0);
IFN_(c1pT_entry) {
EI_(PrelBase_IZh_con_info);
EC_(Int_intToInt64_closure);
FB_
HP_STK_CHK_NP(4,2,1,);
UPD_BH_UPDATABLE(R1.p);
PUSH_UPD_FRAME(R1.p,0);
SET_HDR_(Hp-1,(P_)&PrelBase_IZh_con_info,0);
*Hp=(W_)(64);
Sp[-4]=(W_)(Hp-1);
R1.p=(P_)&Int_intToInt64_closure;
Sp=Sp-4;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT(c1pK_info,c1pK_entry,0,2,Main_main_srt,0,4,THUNK,static const,IF_,0,0);
IFN_(c1pK_entry) {
II_(c1pL_info);
II_(c1pM_info);
II_(c1pR_info);
II_(c1pT_info);
EF_(Main_foo_entry);
FB_
HP_STK_CHK_NP(7,12,1,);
UPD_BH_UPDATABLE(R1.p);
PUSH_UPD_FRAME(R1.p,0);
SET_HDR_(Hp-11,(P_)&c1pL_info,0);
SET_HDR_(Hp-8,(P_)&c1pM_info,0);
SET_HDR_(Hp-5,(P_)&c1pR_info,0);
SET_HDR_(Hp-2,(P_)&c1pT_info,0);
Sp[-4]=(W_)(Hp-2);
Sp[-5]=(W_)(Hp-5);
Sp[-6]=(W_)(Hp-8);
Sp[-7]=(W_)(Hp-11);
Sp=Sp-7;
JMP_(Main_foo_entry);
FE_
}
INFO_TABLE_SRT(c1pV_info,c1pV_entry,0,1,Main_main_srt,4,1,FUN,static const,IF_,0,0);
IFN_(c1pV_entry) {
IF_(c1pV_fast1);
FB_
ARGS_CHK(1);
JMP_(c1pV_fast1);
FE_
}
IFN_(c1pV_fast1) {
EC_(PrelBase_Z40Z41_static_closure);
IC_(c1pO_closure);
FB_
*Sp=(W_)((P_)&PrelBase_Z40Z41_static_closure);
R1.p=(P_)&c1pO_closure;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT_BITMAP(c1pP_info,c1pP_ret,0,Main_main_srt,0,5,RET_SMALL,static
const,IF_,0,0);
IFN_(c1pP_ret) {
II_(c1pK_info);
II_(c1pV_info);
FB_
HP_CHK_NP(5,1,);
SET_HDR_(Hp-4,(P_)&c1pK_info,0);
SET_HDR_(Hp-1,(P_)&c1pV_info,0);
*Sp=(W_)(Hp-1);
Sp[-1]=(W_)(Hp-4);
R1.p=(P_)(R1.p[3]);
Sp=Sp-1;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
INFO_TABLE_SRT(Main_main_info,Main_main_entry,0,2,Main_main_srt,0,6,THUNK_STATIC,const,EF_,0,0);
FN_(Main_main_entry) {
EC_(PrelIOBase__dMonadIO0_closure);
FB_
HP_STK_CHK_NP(5,3,1,);
SET_HDR_(Hp-2,(P_)&BLACKHOLE_info,0);
UPD_CAF(R1.p,Hp-2);
PUSH_UPD_FRAME(Hp-2,0);
R1.p=(P_)&PrelIOBase__dMonadIO0_closure;
Sp[-4]=(W_)((P_)&c1pP_info);
Sp=Sp-4;
JMP_((P_) (ENTRY_CODE((D_)(*R1.p))));
FE_
}
static char ghc_hsc_ID[] = "@(#)hsc ffi-bug.hs 40.0,,";
