Simon Jakobi pushed to branch wip/sjakobi/T26665-fr at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • compiler/GHC/CmmToAsm/Reg/Linear.hs
    ... ... @@ -367,7 +367,7 @@ initBlock id block_live
    367 367 
                               Nothing ->
    368 368 
                                 setFreeRegsR    (frInitFreeRegs platform)
    369 369 
                               Just live ->
    370 
    -                            setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)
    370 
    +                            setFreeRegsR $ foldl' (flip frAllocateReg) (frInitFreeRegs platform)
    371 371 
                                                       (nonDetEltsUniqSet $ takeRealRegs $ getRegs live)
    372 372 
                                 -- See Note [Unique Determinism and code generation]
    373 373 
                             setAssigR       emptyRegMap
    ... ... @@ -638,20 +638,19 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
    638 638
    639 639 
     releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()
    640 640 
     releaseRegs regs = do
    641 
    -  platform <- getPlatform
    642 641 
       assig <- getAssigR
    643 642 
       free <- getFreeRegsR
    644 643
    645 644 
       let loop assig !free [] = do setAssigR assig; setFreeRegsR free; return ()
    646 
    -      loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
    645 
    +      loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg rr free) rs
    647 646 
           loop assig !free (r:rs) =
    648 647 
              case lookupUFM assig r of
    649 648 
              Just (Loc (InBoth real _) _) ->
    650 649 
                loop (delFromUFM assig r)
    651 
    -                (frReleaseReg platform real free) rs
    650 
    +                (frReleaseReg real free) rs
    652 651 
              Just (Loc (InReg real) _) ->
    653 652 
                loop (delFromUFM assig r)
    654 
    -                (frReleaseReg platform real free) rs
    653 
    +                (frReleaseReg real free) rs
    655 654 
              _ ->
    656 655 
                loop (delFromUFM assig r) free rs
    657 656 
       loop assig free regs
    ... ... @@ -716,7 +715,7 @@ saveClobberedTemps clobbered dying
    716 715
    717 716 
                 freeRegs <- getFreeRegsR
    718 717 
                 let regclass = targetClassOfRealReg platform reg
    719 
    -                freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs
    718 
    +                freeRegs_thisClass = frGetFreeRegs regclass freeRegs
    720 719
    721 720 
                 case filter (`notElem` clobbered) freeRegs_thisClass of
    722 721
    ... ... @@ -724,7 +723,7 @@ saveClobberedTemps clobbered dying
    724 723 
                   -- clobbered by this instruction; use it to save the
    725 724 
                   -- clobbered value.
    726 725 
                   (my_reg : _) -> do
    727 
    -                  setFreeRegsR (frAllocateReg platform my_reg freeRegs)
    726 
    +                  setFreeRegsR (frAllocateReg my_reg freeRegs)
    728 727
    729 728 
                       let new_assign = addToUFM_Directly assig temp (Loc (InReg my_reg) fmt)
    730 729 
                       let instr = mkRegRegMoveInstr config fmt
    ... ... @@ -763,13 +762,13 @@ clobberRegs clobbered
    763 762 
                      Unified   ->   Unified.allRegClasses
    764 763 
                      Separate  ->  Separate.allRegClasses
    765 764 
                      NoVectors -> NoVectors.allRegClasses
    766 
    -            allFreeRegs = foldMap (\ rc -> frGetFreeRegs platform rc freeregs) allRegClasses
    765 
    +            allFreeRegs = foldMap (\ rc -> frGetFreeRegs rc freeregs) allRegClasses
    767 766
    768 767 
             let extra_clobbered = [ r | r <- clobbered, r `elem` allFreeRegs ]
    769 768
    770 
    -        setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs extra_clobbered
    769 
    +        setFreeRegsR $! foldl' (flip frAllocateReg) freeregs extra_clobbered
    771 770
    772 
    -        -- setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs clobbered
    771 
    +        -- setFreeRegsR $! foldl' (flip frAllocateReg) freeregs clobbered
    773 772
    774 773 
             assig           <- getAssigR
    775 774 
             setAssigR $! clobber assig (nonDetUFMToList assig)
    ... ... @@ -896,7 +895,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrF
    896 895 
      = do   platform <- getPlatform
    897 896 
             freeRegs <- getFreeRegsR
    898 897 
             let regclass = classOfVirtualReg (platformArch platform) vr
    899 
    -            freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs :: [RealReg]
    898 
    +            freeRegs_thisClass = frGetFreeRegs regclass freeRegs :: [RealReg]
    900 899
    901 900 
             -- Can we put the variable into a register it already was?
    902 901 
             pref_reg <- findPrefRealReg vr
    ... ... @@ -915,7 +914,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrF
    915 914
    916 915 
                     setAssigR $ toRegMap
    917 916 
                               $ (addToUFM assig vr $! newLocation spill_loc $ RealRegUsage final_reg vrFmt)
    918 
    -                setFreeRegsR $  frAllocateReg platform final_reg freeRegs
    917 
    +                setFreeRegsR $  frAllocateReg final_reg freeRegs
    919 918
    920 919 
                     allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs
    921 920

  • compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
    ... ... @@ -43,49 +43,51 @@ import qualified GHC.CmmToAsm.RV64.Instr as RV64.Instr
    43 43 
     import qualified GHC.CmmToAsm.LA64.Instr    as LA64.Instr
    44 44
    45 45 
     class Show freeRegs => FR freeRegs where
    46 
    -    frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs
    47 
    -    frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]
    46 
    +    frAllocateReg :: RealReg -> freeRegs -> freeRegs
    47 
    +    frGetFreeRegs :: RegClass -> freeRegs -> [RealReg]
    48 
    +    -- | The initial allocatable set is platform-dependent. See Note
    49 
    +    -- [Aarch64 Register x18 at Darwin and Windows] in GHC.Platform.Regs.
    48 50 
         frInitFreeRegs :: Platform -> freeRegs
    49 
    -    frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs
    51 
    +    frReleaseReg :: RealReg -> freeRegs -> freeRegs
    50 52
    51 53 
     instance FR X86.FreeRegs where
    52 
    -    frAllocateReg  = \_ -> X86.allocateReg
    54 
    +    frAllocateReg  = X86.allocateReg
    53 55 
         frGetFreeRegs  = X86.getFreeRegs
    54 56 
         frInitFreeRegs = X86.initFreeRegs
    55 
    -    frReleaseReg   = \_ -> X86.releaseReg
    57 
    +    frReleaseReg   = X86.releaseReg
    56 58
    57 59 
     instance FR X86_64.FreeRegs where
    58 
    -    frAllocateReg  = \_ -> X86_64.allocateReg
    60 
    +    frAllocateReg  = X86_64.allocateReg
    59 61 
         frGetFreeRegs  = X86_64.getFreeRegs
    60 62 
         frInitFreeRegs = X86_64.initFreeRegs
    61 
    -    frReleaseReg   = \_ -> X86_64.releaseReg
    63 
    +    frReleaseReg   = X86_64.releaseReg
    62 64
    63 65 
     instance FR PPC.FreeRegs where
    64 
    -    frAllocateReg  = \_ -> PPC.allocateReg
    65 
    -    frGetFreeRegs  = \_ -> PPC.getFreeRegs
    66 
    +    frAllocateReg  = PPC.allocateReg
    67 
    +    frGetFreeRegs  = PPC.getFreeRegs
    66 68 
         frInitFreeRegs = PPC.initFreeRegs
    67 
    -    frReleaseReg   = \_ -> PPC.releaseReg
    69 
    +    frReleaseReg   = PPC.releaseReg
    68 70
    69 71 
     instance FR AArch64.FreeRegs where
    70 
    -    frAllocateReg = \_ -> AArch64.allocateReg
    71 
    -    frGetFreeRegs = \_ -> AArch64.getFreeRegs
    72 
    +    frAllocateReg = AArch64.allocateReg
    73 
    +    frGetFreeRegs = AArch64.getFreeRegs
    72 74 
         frInitFreeRegs = AArch64.initFreeRegs
    73 
    -    frReleaseReg = \_ -> AArch64.releaseReg
    75 
    +    frReleaseReg = AArch64.releaseReg
    74 76
    75 77 
     instance FR RV64.FreeRegs where
    76 
    -    frAllocateReg = const RV64.allocateReg
    77 
    -    frGetFreeRegs = const RV64.getFreeRegs
    78 
    +    frAllocateReg = RV64.allocateReg
    79 
    +    frGetFreeRegs = RV64.getFreeRegs
    78 80 
         frInitFreeRegs = RV64.initFreeRegs
    79 
    -    frReleaseReg = const RV64.releaseReg
    81 
    +    frReleaseReg = RV64.releaseReg
    80 82
    81 83 
     instance FR LA64.FreeRegs where
    82 
    -    frAllocateReg = \_ -> LA64.allocateReg
    83 
    -    frGetFreeRegs = \_ -> LA64.getFreeRegs
    84 
    +    frAllocateReg = LA64.allocateReg
    85 
    +    frGetFreeRegs = LA64.getFreeRegs
    84 86 
         frInitFreeRegs = LA64.initFreeRegs
    85 
    -    frReleaseReg = \_ -> LA64.releaseReg
    87 
    +    frReleaseReg = LA64.releaseReg
    86 88
    87 89 
     allFreeRegs :: FR freeRegs => Platform -> freeRegs -> [RealReg]
    88 
    -allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs plat rcls fr) allRegClasses
    90 
    +allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs rcls fr) allRegClasses
    89 91 
       where
    90 92 
         allRegClasses =
    91 93 
           case registerArch (platformArch plat) of

  • compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
    ... ... @@ -15,7 +15,6 @@ import GHC.CmmToAsm.Reg.Linear.Base
    15 15 
     import GHC.CmmToAsm.Reg.Linear.FreeRegs
    16 16 
     import GHC.CmmToAsm.Reg.Liveness
    17 17 
     import GHC.CmmToAsm.Instr
    18 
    -import GHC.CmmToAsm.Config
    19 18 
     import GHC.CmmToAsm.Types
    20 19
    21 20 
     import GHC.Platform.Reg
    ... ... @@ -132,12 +131,9 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
    132 131 
             block_assig src_assig
    133 132 
             to_free
    134 133
    135 
    - = do   config <- getConfig
    136 
    -        let platform = ncgPlatform config
    137 
    -
    138 
    -        -- free up the regs that are not live on entry to this block.
    134 
    + = do   -- free up the regs that are not live on entry to this block.
    139 135 
             freeregs        <- getFreeRegsR
    140 
    -        let freeregs' = foldl' (flip $ frReleaseReg platform) freeregs to_free
    136 
    +        let freeregs' = foldl' (flip frReleaseReg) freeregs to_free
    141 137
    142 138 
             -- remember the current assignment on entry to this block.
    143 139 
             setBlockAssigR (updateBlockAssignment dest (freeregs', src_assig) block_assig)

  • compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
    ... ... @@ -25,17 +25,17 @@ initFreeRegs :: Platform -> FreeRegs
    25 25 
     initFreeRegs platform
    26 26 
             = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
    27 27
    28 
    -getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
    29 
    -getFreeRegs platform cls (FreeRegs f) =
    28 
    +getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily
    29 
    +getFreeRegs cls (FreeRegs f) =
    30 30 
       case cls of
    31 31 
         RcInteger ->
    32 32 
           [ RealRegSingle i
    33 
    -      | i <- intregnos platform
    33 
    +      | i <- intregnos PW4
    34 34 
           , testBit f i
    35 35 
           ]
    36 36 
         RcFloatOrVector ->
    37 37 
           [ RealRegSingle i
    38 
    -      | i <- xmmregnos platform
    38 
    +      | i <- xmmregnos PW4
    39 39 
           , testBit f i
    40 40 
           ]
    41 41

  • compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
    ... ... @@ -25,17 +25,17 @@ initFreeRegs :: Platform -> FreeRegs
    25 25 
     initFreeRegs platform
    26 26 
             = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
    27 27
    28 
    -getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
    29 
    -getFreeRegs platform cls (FreeRegs f) =
    28 
    +getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily
    29 
    +getFreeRegs cls (FreeRegs f) =
    30 30 
       case cls of
    31 31 
         RcInteger ->
    32 32 
           [ RealRegSingle i
    33 
    -      | i <- intregnos platform
    33 
    +      | i <- intregnos PW8
    34 34 
           , testBit f i
    35 35 
           ]
    36 36 
         RcFloatOrVector ->
    37 37 
           [ RealRegSingle i
    38 
    -      | i <- xmmregnos platform
    38 
    +      | i <- xmmregnos PW8
    39 39 
           , testBit f i
    40 40 
           ]
    41 41

  • compiler/GHC/CmmToAsm/X86/RegInfo.hs
    ... ... @@ -41,9 +41,11 @@ regColors platform = listToUFM (normalRegColors platform)
    41 41
    42 42 
     normalRegColors :: Platform -> [(RealReg,String)]
    43 43 
     normalRegColors platform =
    44 
    -    zip (map realRegSingle [0..lastint platform]) colors
    45 
    -        ++ zip (map realRegSingle [firstxmm..lastxmm platform]) greys
    44 
    +    zip (map realRegSingle [0..lastint wordSize]) colors
    45 
    +        ++ zip (map realRegSingle [firstxmm..lastxmm wordSize]) greys
    46 46 
       where
    47 
    +    wordSize = platformWordSize platform
    48 
    +
    47 49 
         -- 16 colors - enough for amd64 gp regs
    48 50 
         colors = ["#800000","#ff0000","#808000","#ffff00","#008000"
    49 51 
                  ,"#00ff00","#008080","#00ffff","#000080","#0000ff"

  • compiler/GHC/CmmToAsm/X86/Regs.hs
    ... ... @@ -194,27 +194,23 @@ spRel platform n
    194 194 
     firstxmm :: RegNo
    195 195 
     firstxmm  = 16
    196 196
    197 
    ---  on 32bit platformOSs, only the first 8 XMM/YMM/ZMM registers are available
    198 
    -lastxmm :: Platform -> RegNo
    199 
    -lastxmm platform
    200 
    - | target32Bit platform = firstxmm + 7  -- xmm0 - xmmm7
    201 
    - | otherwise            = firstxmm + 15 -- xmm0 -xmm15
    197 
    +--  on 32bit platforms, only the first 8 XMM/YMM/ZMM registers are available
    198 
    +lastxmm :: PlatformWordSize -> RegNo
    199 
    +lastxmm PW4 = firstxmm + 7  -- xmm0 - xmm7
    200 
    +lastxmm PW8 = firstxmm + 15 -- xmm0 - xmm15
    202 201
    203 
    -lastint :: Platform -> RegNo
    204 
    -lastint platform
    205 
    - | target32Bit platform = 7 -- not %r8..%r15
    206 
    - | otherwise            = 15
    202 
    +lastint :: PlatformWordSize -> RegNo
    203 
    +lastint PW4 = 7 -- not %r8..%r15
    204 
    +lastint PW8 = 15
    207 205
    208 
    -intregnos :: Platform -> [RegNo]
    209 
    -intregnos platform = [0 .. lastint platform]
    206 
    +intregnos :: PlatformWordSize -> [RegNo]
    207 
    +intregnos wordSize = [0 .. lastint wordSize]
    210 208
    211 
    -
    212 
    -
    213 
    -xmmregnos :: Platform -> [RegNo]
    214 
    -xmmregnos platform = [firstxmm  .. lastxmm platform]
    209 
    +xmmregnos :: PlatformWordSize -> [RegNo]
    210 
    +xmmregnos wordSize = [firstxmm .. lastxmm wordSize]
    215 211
    216 212 
     floatregnos :: Platform -> [RegNo]
    217 
    -floatregnos platform = xmmregnos platform
    213 
    +floatregnos platform = xmmregnos (platformWordSize platform)
    218 214
    219 215 
     -- argRegs is the set of regs which are read for an n-argument call to C.
    220 216 
     -- For archs which pass all args on the stack (x86), is empty.
    ... ... @@ -224,7 +220,7 @@ argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
    224 220
    225 221 
     -- | The complete set of machine registers.
    226 222 
     allMachRegNos :: Platform -> [RegNo]
    227 
    -allMachRegNos platform = intregnos platform ++ floatregnos platform
    223 
    +allMachRegNos platform = intregnos (platformWordSize platform) ++ floatregnos platform
    228 224
    229 225 
     -- | Take the class of a register.
    230 226 
     {-# INLINE classOfRealReg #-}
    ... ... @@ -236,9 +232,11 @@ classOfRealReg :: Platform -> RealReg -> RegClass
    236 232 
     classOfRealReg platform reg
    237 233 
         = case reg of
    238 234 
             RealRegSingle i
    239 
    -            | i <= lastint platform -> RcInteger
    240 
    -            | i <= lastxmm platform -> RcFloatOrVector
    235 
    +            | i <= lastint wordSize -> RcInteger
    236 
    +            | i <= lastxmm wordSize -> RcFloatOrVector
    241 237 
                 | otherwise             -> panic "X86.Reg.classOfRealReg registerSingle too high"
    238 
    +  where
    239 
    +    wordSize = platformWordSize platform
    242 240
    243 241 
     -- machine specific ------------------------------------------------------------
    244 242

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help