X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgForeignCall.hs;h=ce689c42f79c9e81b785c25f7bf8f471e3d63e9e;hb=615d88d1912a81ca3bef44010285424f6c454449;hp=809e10b875fbb8baa567848297ae8356ab941a40;hpb=a02e7f40afc1aab7fe466f949f505c1d7250713d;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index 809e10b..ce689c4 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -78,8 +78,20 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live where (call_args, cmm_target) = case target of - StaticTarget lbl -> (args, CmmLit (CmmLabel - (mkForeignLabel lbl call_size False IsFunction))) + -- If the packageId is Nothing then the label is taken to be in the + -- package currently being compiled. + StaticTarget lbl mPkgId + -> let labelSource + = case mPkgId of + Nothing -> ForeignLabelInThisPackage + Just pkgId -> ForeignLabelInPackage pkgId + in ( args + , CmmLit (CmmLabel + (mkForeignLabel lbl call_size labelSource IsFunction))) + + -- A label imported with "foreign import ccall "dynamic" ..." + -- Note: "dynamic" here doesn't mean "dynamic library". + -- Read the FFI spec for details. DynamicTarget -> case args of (CmmHinted fn _):rest -> (rest, fn) [] -> panic "emitForeignCall: DynamicTarget []" @@ -110,9 +122,10 @@ emitForeignCall' safety results target args vols _srt ret | not (playSafe safety) = do temp_args <- load_args_into_temps args let (caller_save, caller_load) = callerSaveVolatileRegs vols + let caller_load' = if ret == CmmNeverReturns then [] else caller_load stmtsC caller_save stmtC (CmmCall target results temp_args CmmUnsafe ret) - stmtsC caller_load + stmtsC caller_load' | otherwise = do -- Both 'id' and 'new_base' are GCKindNonPtr because they're