X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmForeign.hs;h=83c430143edc8ae692300cefca590d5e83acbc23;hb=83d563cb9ede0ba792836e529b1e2929db926355;hp=bda9e0fe1be85f1215376ee144c50d9dec27aaf2;hpb=7854ec4b11e117f8514553890851d14a66690fbb;p=ghc-hetmet.git diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index bda9e0f..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) - ForeignLabelInThisPackage 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) {-