X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmForeign.hs;h=83c430143edc8ae692300cefca590d5e83acbc23;hb=2d367f855c3556166d24cf538d5c34d0ff596a2f;hp=89a2b27833414db538f89f96fe86b3e4fdc5d89d;hpb=787b08bdea84cca4bf9490d87c059453bffc5ad2;p=ghc-hetmet.git diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index 89a2b27..83c4301 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -56,11 +56,17 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a = do { cmm_args <- getFCallArgs stg_args ; let ((call_args, arg_hints), cmm_target) = case target of - StaticTarget lbl -> - (unzip cmm_args, - CmmLit (CmmLabel (mkForeignLabel lbl (call_size cmm_args) - False IsFunction))) - DynamicTarget -> case cmm_args of + StaticTarget lbl mPkgId + -> let labelSource + = case mPkgId of + Nothing -> ForeignLabelInThisPackage + Just pkgId -> ForeignLabelInPackage pkgId + size = call_size cmm_args + in ( unzip cmm_args + , CmmLit (CmmLabel + (mkForeignLabel lbl size labelSource IsFunction))) + + DynamicTarget -> case cmm_args of (fn,_):rest -> (unzip rest, fn) [] -> panic "cgForeignCall []" fc = ForeignConvention cconv arg_hints result_hints @@ -121,7 +127,7 @@ emitForeignCall safety results target args _srt _ret | otherwise = do updfr_off <- getUpdFrameOff temp_target <- load_target_into_temp target - emit $ mkSafeCall temp_target results args updfr_off + emit $ mkSafeCall temp_target results args updfr_off (playInterruptible safety) {-