X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgUtils.hs;h=75f6b19292b9e46b8b7449688379c3d16b34905e;hb=bfb346895846c5b79ecfb1e7503815146b8a4071;hp=b14d318c66d3ab4f873344e04dc41bbaac5376cc;hpb=0e4eef1e5c326750d1b94c9b365c0b3fab19e611;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index b14d318..75f6b19 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -50,7 +50,7 @@ module CgUtils ( ) where #include "HsVersions.h" -#include "../includes/MachRegs.h" +#include "../includes/stg/MachRegs.h" import BlockId import CgMonad @@ -67,6 +67,7 @@ import CmmUtils import ForeignCall import ClosureInfo import StgSyn (SRT(..)) +import Module import Literal import Digraph import ListSetOps @@ -110,7 +111,7 @@ mkSimpleLit (MachWord i) = CmmInt i wordWidth mkSimpleLit (MachWord64 i) = CmmInt i W64 mkSimpleLit (MachFloat r) = CmmFloat r W32 mkSimpleLit (MachDouble r) = CmmFloat r W64 -mkSimpleLit (MachLabel fs ms) = CmmLabel (mkForeignLabel fs ms is_dyn) +mkSimpleLit (MachLabel fs ms fod) = CmmLabel (mkForeignLabel fs ms is_dyn fod) where is_dyn = False -- ToDo: fix me @@ -331,28 +332,39 @@ emitIfThenElse cond then_part else_part ; labelC join_id } -emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code -emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe + +-- | Emit code to call a Cmm function. +emitRtsCall + :: PackageId -- ^ package the function is in + -> FastString -- ^ name of function + -> [CmmHinted CmmExpr] -- ^ function args + -> Bool -- ^ whether this is a safe call + -> Code -- ^ cmm code + +emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe -- The 'Nothing' says "save all global registers" -emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code -emitRtsCallWithVols fun args vols safe - = emitRtsCall' [] fun args (Just vols) safe +emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code +emitRtsCallWithVols pkg fun args vols safe + = emitRtsCall' [] pkg fun args (Just vols) safe -emitRtsCallWithResult :: LocalReg -> ForeignHint -> LitString - -> [CmmHinted CmmExpr] -> Bool -> Code -emitRtsCallWithResult res hint fun args safe - = emitRtsCall' [CmmHinted res hint] fun args Nothing safe +emitRtsCallWithResult + :: LocalReg -> ForeignHint + -> PackageId -> FastString + -> [CmmHinted CmmExpr] -> Bool -> Code +emitRtsCallWithResult res hint pkg fun args safe + = emitRtsCall' [CmmHinted res hint] pkg fun args Nothing safe -- Make a call to an RTS C procedure emitRtsCall' :: [CmmHinted LocalReg] - -> LitString + -> PackageId + -> FastString -> [CmmHinted CmmExpr] -> Maybe [GlobalReg] -> Bool -- True <=> CmmSafe call -> Code -emitRtsCall' res fun args vols safe = do +emitRtsCall' res pkg fun args vols safe = do safety <- if safe then getSRTInfo >>= (return . CmmSafe) else return CmmUnsafe @@ -362,7 +374,7 @@ emitRtsCall' res fun args vols safe = do where (caller_save, caller_load) = callerSaveVolatileRegs vols target = CmmCallee fun_expr CCallConv - fun_expr = mkLblExpr (mkRtsCodeLabel fun) + fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun) ----------------------------------------------------------------------------- --