never executed always true always false

    1 -- | Register coalescing.
    2 module GHC.CmmToAsm.Reg.Graph.Coalesce (
    3         regCoalesce,
    4         slurpJoinMovs
    5 ) where
    6 import GHC.Prelude
    7 
    8 import GHC.CmmToAsm.Reg.Liveness
    9 import GHC.CmmToAsm.Instr
   10 import GHC.Platform.Reg
   11 
   12 import GHC.Cmm
   13 import GHC.Data.Bag
   14 import GHC.Data.Graph.Directed
   15 import GHC.Types.Unique.FM
   16 import GHC.Types.Unique.Set
   17 import GHC.Types.Unique.Supply
   18 
   19 
   20 -- | Do register coalescing on this top level thing
   21 --
   22 --   For Reg -> Reg moves, if the first reg dies at the same time the
   23 --   second reg is born then the mov only serves to join live ranges.
   24 --   The two regs can be renamed to be the same and the move instruction
   25 --   safely erased.
   26 regCoalesce
   27         :: Instruction instr
   28         => [LiveCmmDecl statics instr]
   29         -> UniqSM [LiveCmmDecl statics instr]
   30 
   31 regCoalesce code
   32  = do
   33         let joins       = foldl' unionBags emptyBag
   34                         $ map slurpJoinMovs code
   35 
   36         let alloc       = foldl' buildAlloc emptyUFM
   37                         $ bagToList joins
   38 
   39         let patched     = map (patchEraseLive (sinkReg alloc)) code
   40 
   41         return patched
   42 
   43 
   44 -- | Add a v1 = v2 register renaming to the map.
   45 --   The register with the lowest lexical name is set as the
   46 --   canonical version.
   47 buildAlloc :: UniqFM Reg Reg -> (Reg, Reg) -> UniqFM Reg Reg
   48 buildAlloc fm (r1, r2)
   49  = let  rmin    = min r1 r2
   50         rmax    = max r1 r2
   51    in   addToUFM fm rmax rmin
   52 
   53 
   54 -- | Determine the canonical name for a register by following
   55 --   v1 = v2 renamings in this map.
   56 sinkReg :: UniqFM Reg Reg -> Reg -> Reg
   57 sinkReg fm r
   58  = case lookupUFM fm r of
   59         Nothing -> r
   60         Just r' -> sinkReg fm r'
   61 
   62 
   63 -- | Slurp out mov instructions that only serve to join live ranges.
   64 --
   65 --   During a mov, if the source reg dies and the destination reg is
   66 --   born then we can rename the two regs to the same thing and
   67 --   eliminate the move.
   68 slurpJoinMovs
   69         :: Instruction instr
   70         => LiveCmmDecl statics instr
   71         -> Bag (Reg, Reg)
   72 
   73 slurpJoinMovs live
   74         = slurpCmm emptyBag live
   75  where
   76         slurpCmm   rs  CmmData{}
   77          = rs
   78 
   79         slurpCmm   rs (CmmProc _ _ _ sccs)
   80          = foldl' slurpBlock rs (flattenSCCs sccs)
   81 
   82         slurpBlock rs (BasicBlock _ instrs)
   83          = foldl' slurpLI    rs instrs
   84 
   85         slurpLI    rs (LiveInstr _      Nothing)    = rs
   86         slurpLI    rs (LiveInstr instr (Just live))
   87                 | Just (r1, r2) <- takeRegRegMoveInstr instr
   88                 , elementOfUniqSet r1 $ liveDieRead live
   89                 , elementOfUniqSet r2 $ liveBorn live
   90 
   91                 -- only coalesce movs between two virtuals for now,
   92                 -- else we end up with allocatable regs in the live
   93                 -- regs list..
   94                 , isVirtualReg r1 && isVirtualReg r2
   95                 = consBag (r1, r2) rs
   96 
   97                 | otherwise
   98                 = rs
   99