mkHpcModuleOffsetLabel,
infoLblToEntryLbl, entryLblToInfoLbl,
- needsCDecl, isAsmTemp, externallyVisibleCLabel,
+ needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
CLabelType(..), labelType, labelDynamic,
pprCLabel
isAsmTemp (AsmTempLabel _) = True
isAsmTemp _ = False
+maybeAsmTemp :: CLabel -> Maybe Unique
+maybeAsmTemp (AsmTempLabel uq) = Just uq
+maybeAsmTemp _ = Nothing
+
-- -----------------------------------------------------------------------------
-- Is a CLabel visible outside this object file or not?
| CmmJump CmmExpr [LocalReg] -- Jump to another function, with these
-- parameters.
+{-
+Discussion
+~~~~~~~~~~
+
+One possible problem with the above type is that the only way to do a
+non-local conditional jump is to encode it as a branch to a block that
+contains a single jump. This leads to inefficient code in the back end.
+
+One possible way to fix this would be:
+
+data CmmStat =
+ ...
+ | CmmJump CmmBranchDest
+ | CmmCondJump CmmExpr CmmBranchDest
+ ...
+
+data CmmBranchDest
+ = Local BlockId
+ | NonLocal CmmExpr [LocalReg]
+
+In favour:
+
++ one fewer constructors in CmmStmt
++ allows both cond branch and switch to jump to non-local destinations
+
+Against:
+
+- not strictly necessary: can already encode as branch+jump
+- not always possible to implement any better in the back end
+- could do the optimisation in the back end (but then plat-specific?)
+- C-- doesn't have it
+- back-end optimisation might be more general (jump shortcutting)
+
+So we'll stick with the way it is, and add the optimisation to the NCG.
+-}
+
-----------------------------------------------------------------------------
-- CmmCallTarget
--
import MachCodeGen
import PprMach
import RegisterAlloc
-import RegAllocInfo ( jumpDests )
+import RegAllocInfo
import NCGMonad
import PositionIndependentCode
import CmmOpt ( cmmMiniInline, cmmMachOpFold )
import PprCmm ( pprStmt, pprCmms )
import MachOp
-import CLabel ( CLabel, mkSplitMarkerLabel, mkAsmTempLabel )
+import CLabel
#if powerpc_TARGET_ARCH
import CLabel ( mkRtsCodeLabel )
#endif
import List ( groupBy, sortBy )
import CLabel ( pprCLabel )
import ErrUtils ( dumpIfSet_dyn )
-import DynFlags ( DynFlags, DynFlag(..), dopt )
+import DynFlags
import StaticFlags ( opt_Static, opt_PIC )
+import Util
import Config ( cProjectVersion )
import Digraph
genMachCode cmm `thenUs` \ (pre_regalloc, lastMinuteImports) ->
{-# SCC "regAlloc" #-}
mapUs regAlloc pre_regalloc `thenUs` \ with_regs ->
+ {-# SCC "shortcutBranches" #-}
+ shortcutBranches dflags with_regs `bind` \ shorted ->
{-# SCC "sequenceBlocks" #-}
- map sequenceTop with_regs `bind` \ sequenced ->
+ map sequenceTop shorted `bind` \ sequenced ->
{-# SCC "x86fp_kludge" #-}
map x86fp_kludge sequenced `bind` \ final_mach_code ->
{-# SCC "vcat" #-}
#endif
-- -----------------------------------------------------------------------------
+-- Shortcut branches
+
+shortcutBranches :: DynFlags -> [NatCmmTop] -> [NatCmmTop]
+shortcutBranches dflags tops
+ | optLevel dflags < 1 = tops -- only with -O or higher
+ | otherwise = map (apply_mapping mapping) tops'
+ where
+ (tops', mappings) = mapAndUnzip build_mapping tops
+ mapping = foldr plusUFM emptyUFM mappings
+
+build_mapping top@(CmmData _ _) = (top, emptyUFM)
+build_mapping (CmmProc info lbl params []) $
+ = (CmmProc info lbl params [], emptyUFM)
+build_mapping (CmmProc info lbl params (head:blocks))
+ = (CmmProc info lbl params (head:others), mapping)
+ -- drop the shorted blocks, but don't ever drop the first one,
+ -- because it is pointed to by a global label.
+ where
+ -- find all the blocks that just consist of a jump that can be
+ -- shorted.
+ (shortcut_blocks, others) = partitionWith split blocks
+ split (BasicBlock id [insn]) | Just dest <- canShortcut insn
+ = Left (id,dest)
+ split other = Right other
+
+ -- build a mapping from BlockId to JumpDest for shorting branches
+ mapping = foldl add emptyUFM shortcut_blocks
+ add ufm (id,dest) = addToUFM ufm id dest
+
+apply_mapping ufm (CmmData sec statics)
+ = CmmData sec (map (shortcutStatic (lookupUFM ufm)) statics)
+ -- we need to get the jump tables, so apply the mapping to the entries
+ -- of a CmmData too.
+apply_mapping ufm (CmmProc info lbl params blocks)
+ = CmmProc info lbl params (map short_bb blocks)
+ where
+ short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns
+ short_insn i = shortcutJump (lookupUFM ufm) i
+ -- shortcutJump should apply the mapping repeatedly,
+ -- just in case we can short multiple branches.
+
+-- -----------------------------------------------------------------------------
-- Instruction selection
-- Native code instruction selection for a chunk of stix code. For
-- Jumping around.
| JMP Operand
| JXX Cond BlockId -- includes unconditional branches
+ | JXX_GBL Cond Imm -- non-local version of JXX
| JMP_TBL Operand [BlockId] -- table jump
| CALL (Either Imm Reg) [Reg]
= pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
where lab = mkAsmTempLabel id
+pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
+
pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
patchJump,
isRegRegMove,
+ JumpDest, canShortcut, shortcutJump, shortcutStatic,
+
maxSpillSlots,
mkSpillInstr,
mkLoadInstr,
#include "HsVersions.h"
-import Cmm ( BlockId )
+import Cmm
+import CLabel
import MachOp ( MachRep(..), wordRep )
import MachInstrs
import MachRegs
CMP sz src dst -> mkRUR (use_R src ++ use_R dst)
SETCC cond op -> mkRU [] (def_W op)
JXX cond lbl -> mkRU [] []
+ JXX_GBL cond lbl -> mkRU [] []
JMP op -> mkRUR (use_R op)
JMP_TBL op ids -> mkRUR (use_R op)
CALL (Left imm) params -> mkRU params callClobberedRegs
#endif
_other -> insn
+data JumpDest = DestBlockId BlockId | DestImm Imm
+
+canShortcut :: Instr -> Maybe JumpDest
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+canShortcut (JXX ALWAYS id) = Just (DestBlockId id)
+canShortcut (JMP (OpImm imm)) = Just (DestImm imm)
+#endif
+canShortcut _ = Nothing
+
+shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+shortcutJump fn insn@(JXX cc id) =
+ case fn id of
+ Nothing -> insn
+ Just (DestBlockId id') -> shortcutJump fn (JXX cc id')
+ Just (DestImm imm) -> shortcutJump fn (JXX_GBL cc imm)
+#endif
+shortcutJump fn other = other
+
+-- Here because it knows about JumpDest
+shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
+shortcutStatic fn (CmmStaticLit (CmmLabel lab))
+ | Just uq <- maybeAsmTemp lab
+ = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
+shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
+ | Just uq <- maybeAsmTemp lbl1
+ = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
+ -- slightly dodgy, we're ignoring the second label, but this
+ -- works with the way we use CmmLabelDiffOff for jump tables now.
+shortcutStatic fn other_static
+ = other_static
+
+shortBlockId fn blockid@(BlockId uq) =
+ case fn blockid of
+ Nothing -> mkAsmTempLabel uq
+ Just (DestBlockId blockid') -> shortBlockId fn blockid'
+ Just (DestImm (ImmCLbl lbl)) -> lbl
+ _other -> panic "shortBlockId"
+
-- -----------------------------------------------------------------------------
-- 'patchRegs' function
COMMENT _ -> instr
DELTA _ -> instr
JXX _ _ -> instr
+ JXX_GBL _ _ -> instr
CLTD _ -> instr
_other -> panic "patchRegs: unrecognised instr"
projects / ghc-hetmet.git / commitdiff