----------------------------------------------------------------------------- -- -- Machine-specific parts of the register allocator -- -- (c) The University of Glasgow 1996-2004 -- ----------------------------------------------------------------------------- {-# OPTIONS -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details module PPC.RegInfo ( JumpDest( DestBlockId ), getJumpDestBlockId, canShortcut, shortcutJump, shortcutStatics ) where #include "nativeGen/NCG.h" #include "HsVersions.h" import PPC.Instr import BlockId import Cmm import CLabel import Unique data JumpDest = DestBlockId BlockId getJumpDestBlockId :: JumpDest -> Maybe BlockId getJumpDestBlockId (DestBlockId bid) = Just bid canShortcut :: Instr -> Maybe JumpDest canShortcut _ = Nothing shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr shortcutJump _ other = other -- Here because it knows about JumpDest shortcutStatics :: (BlockId -> Maybe JumpDest) -> CmmStatics -> CmmStatics shortcutStatics fn (Statics lbl statics) = Statics lbl $ map (shortcutStatic fn) statics -- we need to get the jump tables, so apply the mapping to the entries -- of a CmmData too. shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel shortcutLabel fn lab | Just uq <- maybeAsmTemp lab = shortBlockId fn (mkBlockId uq) | otherwise = lab shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic shortcutStatic fn (CmmStaticLit (CmmLabel lab)) = CmmStaticLit (CmmLabel (shortcutLabel fn lab)) shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off)) = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off) -- slightly dodgy, we're ignoring the second label, but this -- works with the way we use CmmLabelDiffOff for jump tables now. shortcutStatic _ other_static = other_static shortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel shortBlockId fn blockid = case fn blockid of Nothing -> mkAsmTempLabel uq Just (DestBlockId blockid') -> shortBlockId fn blockid' where uq = getUnique blockid