compiler/nativeGen/Regs.hs

   1 -- -----------------------------------------------------------------------------
   2 --
   3 -- (c) The University of Glasgow 1994-2004
   4 --
   5 -- Machine-specific info about registers.
   6 --
   7 -- Also includes stuff about immediate operands, which are
   8 -- often/usually quite entangled with registers.
   9 --
  10 -- -----------------------------------------------------------------------------
  11
  12 #include "nativeGen/NCG.h"
  13
  14 module Regs (
  15         --------------------------------
  16         -- Generic things, shared by all architectures.
  17         module RegsBase,
  18         getHiVRegFromLo,
  19         get_GlobalReg_reg_or_addr,
  20         allocatableRegs,
  21         allocatableRegsInClass,
  22         trivColorable,
  23
  24         --------------------------------
  25         -- Things that are defined by the arch specific module.
  26         --
  27
  28         -- sizes
  29         Size(..),
  30         intSize,
  31         floatSize,
  32         isFloatSize,
  33         wordSize,
  34         cmmTypeSize,
  35         sizeToWidth,
  36         mkVReg,
  37
  38         -- immediates
  39         Imm(..),
  40         strImmLit,
  41         litToImm,
  42
  43         -- addressing modes
  44         AddrMode(..),
  45         addrOffset,
  46
  47         -- registers
  48         spRel,
  49         argRegs,
  50         allArgRegs,
  51         callClobberedRegs,
  52         allMachRegNos,
  53         regClass,
  54         showReg,
  55
  56         -- machine specific things
  57 #if   powerpc_TARGET_ARCH
  58         allFPArgRegs,
  59         fits16Bits,
  60         makeImmediate,
  61         freg,
  62         sp, r3, r4, r27, r28, f1, f20, f21,
  63
  64 #elif i386_TARGET_ARCH || i386_64_TARGET_ARCH
  65         EABase(..), EAIndex(..), addrModeRegs,
  66
  67         eax, ebx, ecx, edx, esi, edi, ebp, esp,
  68         fake0, fake1, fake2, fake3, fake4, fake5,
  69         rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp,
  70         eax, ebx, ecx, edx, esi, edi, ebp, esp,
  71         r8, r9, r10, r11, r12, r13, r14, r15,
  72         xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
  73         xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15,
  74         xmm,
  75
  76         ripRel,
  77         allFPArgRegs,
  78
  79 #elif sparc_TARGET_ARCH
  80         fpRel,
  81         fits13Bits,
  82         largeOffsetError,
  83         gReg, iReg, lReg, oReg, fReg,
  84         fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27,
  85         nCG_FirstFloatReg,
  86 #endif
  87         -- horror show
  88         freeReg,
  89         globalRegMaybe
  90 )
  91
  92 where
  93
  94 #include "HsVersions.h"
  95 #include "../includes/MachRegs.h"
  96
  97 import Cmm
  98 import CgUtils          ( get_GlobalReg_addr )
  99 import Outputable       ( Outputable(..), pprPanic )
 100 import qualified Outputable
 101 import Panic
 102 import Unique
 103 import UniqSet
 104 import FastTypes
 105 import FastBool
 106 import UniqFM
 107
 108
 109 import RegsBase
 110
 111 #if   alpha_TARGET_ARCH
 112 import Alpha.Regs
 113 #elif powerpc_TARGET_ARCH
 114 import PPC.Regs
 115 #elif i386_TARGET_ARCH || x86_64_TARGET_ARCH
 116 import X86.Regs
 117 #elif sparc_TARGET_ARCH
 118 import SPARC.Regs
 119 #else
 120 #error "Regs: not defined for this architecture"
 121 #endif
 122
 123
 124
 125 instance Show Reg where
 126         show (RealReg i)      = showReg i
 127         show (VirtualRegI u)  = "%vI_" ++ show u
 128         show (VirtualRegHi u) = "%vHi_" ++ show u
 129         show (VirtualRegF u)  = "%vF_" ++ show u
 130         show (VirtualRegD u)  = "%vD_" ++ show u
 131
 132 instance Outputable Reg where
 133         ppr r = Outputable.text (show r)
 134
 135
 136 -- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
 137 -- when supplied with the vreg for the lower-half of the quantity.
 138 -- (NB. Not reversible).
 139 getHiVRegFromLo :: Reg -> Reg
 140 getHiVRegFromLo (VirtualRegI u)
 141    = VirtualRegHi (newTagUnique u 'H') -- makes a pseudo-unique with tag 'H'
 142
 143 getHiVRegFromLo other
 144    = pprPanic "getHiVRegFromLo" (ppr other)
 145
 146 -- -----------------------------------------------------------------------------
 147 -- Global registers
 148
 149 -- We map STG registers onto appropriate CmmExprs.  Either they map
 150 -- to real machine registers or stored as offsets from BaseReg.  Given
 151 -- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real
 152 -- register it is in, on this platform, or a CmmExpr denoting the
 153 -- address in the register table holding it.
 154 -- (See also get_GlobalReg_addr in CgUtils.)
 155
 156 get_GlobalReg_reg_or_addr       :: GlobalReg -> Either Reg CmmExpr
 157 get_GlobalReg_reg_or_addr mid
 158    = case globalRegMaybe mid of
 159         Just rr -> Left rr
 160         Nothing -> Right (get_GlobalReg_addr mid)
 161
 162
 163 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
 164 -- i.e., these are the regs for which we are prepared to allow the
 165 -- register allocator to attempt to map VRegs to.
 166 allocatableRegs :: [RegNo]
 167 allocatableRegs
 168    = let isFree i = isFastTrue (freeReg i)
 169      in  filter isFree allMachRegNos
 170
 171
 172 -- | The number of regs in each class.
 173 --      We go via top level CAFs to ensure that we're not recomputing
 174 --      the length of these lists each time the fn is called.
 175 allocatableRegsInClass :: RegClass -> Int
 176 allocatableRegsInClass cls
 177  = case cls of
 178         RcInteger       -> allocatableRegsInteger
 179         RcDouble        -> allocatableRegsDouble
 180         RcFloat         -> panic "Regs.allocatableRegsInClass: no match\n"
 181
 182 allocatableRegsInteger :: Int
 183 allocatableRegsInteger
 184         = length $ filter (\r -> regClass r == RcInteger)
 185                  $ map RealReg allocatableRegs
 186
 187 allocatableRegsDouble :: Int
 188 allocatableRegsDouble
 189         = length $ filter (\r -> regClass r == RcDouble)
 190                  $ map RealReg allocatableRegs
 191
 192
 193
 194 -- trivColorable ---------------------------------------------------------------
 195
 196 -- trivColorable function for the graph coloring allocator
 197 --      This gets hammered by scanGraph during register allocation,
 198 --      so needs to be fairly efficient.
 199 --
 200 --      NOTE:   This only works for arcitectures with just RcInteger and RcDouble
 201 --              (which are disjoint) ie. x86, x86_64 and ppc
 202 --
 203
 204 --      BL 2007/09
 205 --      Doing a nice fold over the UniqSet makes trivColorable use
 206 --      32% of total compile time and 42% of total alloc when compiling SHA1.lhs from darcs.
 207 {-
 208 trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
 209 trivColorable classN conflicts exclusions
 210  = let
 211
 212         acc :: Reg -> (Int, Int) -> (Int, Int)
 213         acc r (cd, cf)
 214          = case regClass r of
 215                 RcInteger       -> (cd+1, cf)
 216                 RcDouble        -> (cd,   cf+1)
 217                 _               -> panic "Regs.trivColorable: reg class not handled"
 218
 219         tmp                     = foldUniqSet acc (0, 0) conflicts
 220         (countInt,  countFloat) = foldUniqSet acc tmp    exclusions
 221
 222         squeese         = worst countInt   classN RcInteger
 223                         + worst countFloat classN RcDouble
 224
 225    in   squeese < allocatableRegsInClass classN
 226
 227 -- | Worst case displacement
 228 --      node N of classN has n neighbors of class C.
 229 --
 230 --      We currently only have RcInteger and RcDouble, which don't conflict at all.
 231 --      This is a bit boring compared to what's in RegArchX86.
 232 --
 233 worst :: Int -> RegClass -> RegClass -> Int
 234 worst n classN classC
 235  = case classN of
 236         RcInteger
 237          -> case classC of
 238                 RcInteger       -> min n (allocatableRegsInClass RcInteger)
 239                 RcDouble        -> 0
 240
 241         RcDouble
 242          -> case classC of
 243                 RcDouble        -> min n (allocatableRegsInClass RcDouble)
 244                 RcInteger       -> 0
 245 -}
 246
 247
 248 -- The number of allocatable regs is hard coded here so we can do a fast comparision
 249 -- in trivColorable. It's ok if these numbers are _less_ than the actual number of
 250 -- free regs, but they can't be more or the register conflict graph won't color.
 251 --
 252 -- There is an allocatableRegsInClass :: RegClass -> Int, but doing the unboxing
 253 -- is too slow for us here.
 254 --
 255 -- Compare Regs.freeRegs  and MachRegs.h to get these numbers.
 256 --
 257 #if i386_TARGET_ARCH
 258 #define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
 259 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
 260 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
 261
 262 #elif x86_64_TARGET_ARCH
 263 #define ALLOCATABLE_REGS_INTEGER (_ILIT(5))
 264 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(2))
 265 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
 266
 267 #elif powerpc_TARGET_ARCH
 268 #define ALLOCATABLE_REGS_INTEGER (_ILIT(16))
 269 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(26))
 270 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
 271
 272 #elif sparc_TARGET_ARCH
 273 #define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
 274 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
 275 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
 276
 277 #else
 278 #error ToDo: define ALLOCATABLE_REGS_INTEGER and ALLOCATABLE_REGS_DOUBLE
 279 #endif
 280
 281 trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
 282 trivColorable _ conflicts exclusions
 283  = {-# SCC "trivColorable" #-}
 284    let
 285         isSqueesed cI cF ufm
 286           = case ufm of
 287                 NodeUFM _ _ left right
 288                  -> case isSqueesed cI cF right of
 289                         (# s, cI', cF' #)
 290                          -> case s of
 291                                 False   -> isSqueesed cI' cF' left
 292                                 True    -> (# True, cI', cF' #)
 293
 294                 LeafUFM _ reg
 295                  -> case regClass reg of
 296                         RcInteger
 297                          -> case cI +# _ILIT(1) of
 298                                 cI' -> (# cI' >=# ALLOCATABLE_REGS_INTEGER, cI', cF #)
 299
 300                         RcDouble
 301                          -> case cF +# _ILIT(1) of
 302                                 cF' -> (# cF' >=# ALLOCATABLE_REGS_DOUBLE,  cI, cF' #)
 303
 304                         RcFloat
 305                          -> case cF +# _ILIT(1) of
 306                                 cF' -> (# cF' >=# ALLOCATABLE_REGS_FLOAT,   cI, cF' #)
 307
 308                 EmptyUFM
 309                  ->     (# False, cI, cF #)
 310
 311    in case isSqueesed (_ILIT(0)) (_ILIT(0)) conflicts of
 312         (# False, cI', cF' #)
 313          -> case isSqueesed cI' cF' exclusions of
 314                 (# s, _, _ #)   -> not s
 315
 316         (# True, _, _ #)
 317          -> False
 318
 319