-- -----------------------------------------------------------------------------
\begin{code}
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
#include "nativeGen/NCG.h"
module MachRegs (
-- * The 'Reg' type
RegNo,
- Reg(..), isRealReg, isVirtualReg,
+ Reg(..), isRealReg, isVirtualReg, renameVirtualReg,
RegClass(..), regClass,
+ trivColorable,
getHiVRegFromLo,
mkVReg,
-- * Global registers
get_GlobalReg_reg_or_addr,
- callerSaves, callerSaveVolatileRegs,
-- * Machine-dependent register-related stuff
allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
-- HACK: go for the max
#endif
-#include "../includes/MachRegs.h"
+#include "MachRegs.h"
import Cmm
import MachOp ( MachRep(..) )
+import CgUtils ( get_GlobalReg_addr )
import CLabel ( CLabel, mkMainCapabilityLabel )
import Pretty
import Outputable ( Outputable(..), pprPanic, panic )
import qualified Outputable
import Unique
+import UniqSet
import Constants
import FastTypes
-- We map STG registers onto appropriate CmmExprs. Either they map
-- to real machine registers or stored as offsets from BaseReg. Given
-- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real
--- register it is in, on this platform, or a StixExpr denoting the
--- address in the register table holding it. get_MagicId_addr always
--- produces the register table address for it.
+-- register it is in, on this platform, or a CmmExpr denoting the
+-- address in the register table holding it.
+-- (See also get_GlobalReg_addr in CgUtils.)
get_GlobalReg_reg_or_addr :: GlobalReg -> Either Reg CmmExpr
-get_GlobalReg_addr :: GlobalReg -> CmmExpr
-get_Regtable_addr_from_offset :: MachRep -> Int -> CmmExpr
-
get_GlobalReg_reg_or_addr mid
= case globalRegMaybe mid of
Just rr -> Left rr
Nothing -> Right (get_GlobalReg_addr mid)
-get_GlobalReg_addr BaseReg = regTableOffset 0
-get_GlobalReg_addr mid = get_Regtable_addr_from_offset
- (globalRegRep mid) (baseRegOffset mid)
-
--- Calculate a literal representing an offset into the register table.
--- Used when we don't have an actual BaseReg to offset from.
-regTableOffset n =
- CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
-
-get_Regtable_addr_from_offset rep offset
- = case globalRegMaybe BaseReg of
- Nothing -> regTableOffset offset
- Just _ -> CmmRegOff (CmmGlobal BaseReg) offset
-
--- -----------------------------------------------------------------------------
--- caller-save registers
-
--- Here we generate the sequence of saves/restores required around a
--- foreign call instruction.
-
-callerSaveVolatileRegs :: Maybe [GlobalReg] -> ([CmmStmt], [CmmStmt])
-callerSaveVolatileRegs vols = (caller_save, caller_load)
- where
- caller_save = foldr ($!) [] (map callerSaveGlobalReg regs_to_save)
- caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
-
- system_regs = [Sp,SpLim,Hp,HpLim,CurrentTSO,CurrentNursery,
- {-SparkHd,SparkTl,SparkBase,SparkLim,-}BaseReg ]
-
- regs_to_save = system_regs ++ vol_list
-
- vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
-
- all_of_em = [ VanillaReg n | n <- [0..mAX_Vanilla_REG] ]
- ++ [ FloatReg n | n <- [0..mAX_Float_REG] ]
- ++ [ DoubleReg n | n <- [0..mAX_Double_REG] ]
- ++ [ LongReg n | n <- [0..mAX_Long_REG] ]
-
- callerSaveGlobalReg reg next
- | callerSaves reg =
- CmmStore (get_GlobalReg_addr reg)
- (CmmReg (CmmGlobal reg)) : next
- | otherwise = next
-
- callerRestoreGlobalReg reg next
- | callerSaves reg =
- CmmAssign (CmmGlobal reg)
- (CmmLoad (get_GlobalReg_addr reg) (globalRegRep reg))
- : next
- | otherwise = next
-
-
-- ---------------------------------------------------------------------------
-- Registers
| RcDouble
deriving Eq
+instance Uniquable RegClass where
+ getUnique RcInteger = mkUnique 'L' 0
+ getUnique RcFloat = mkUnique 'L' 1
+ getUnique RcDouble = mkUnique 'L' 2
+
type RegNo = Int
data Reg
isRealReg :: Reg -> Bool
isRealReg = not . isVirtualReg
+renameVirtualReg :: Unique -> Reg -> Reg
+renameVirtualReg u r
+ = case r of
+ RealReg _ -> error "renameVirtualReg: can't change unique on a real reg"
+ VirtualRegI _ -> VirtualRegI u
+ VirtualRegHi _ -> VirtualRegHi u
+ VirtualRegF _ -> VirtualRegF u
+ VirtualRegD _ -> VirtualRegD u
+
instance Show Reg where
show (RealReg i) = showReg i
show (VirtualRegI u) = "%vI_" ++ show u
show (VirtualRegF u) = "%vF_" ++ show u
show (VirtualRegD u) = "%vD_" ++ show u
+instance Outputable RegClass where
+ ppr RcInteger = Outputable.text "I"
+ ppr RcFloat = Outputable.text "F"
+ ppr RcDouble = Outputable.text "D"
+
instance Outputable Reg where
ppr r = Outputable.text (show r)
+
+
+-- trivColorable function for the graph coloring allocator
+-- This gets hammered by scanGraph during register allocation,
+-- so needs to be fairly efficient.
+--
+-- NOTE: This only works for arcitectures with just RcInteger and RcDouble
+-- (which are disjoint) ie. x86, x86_64 and ppc
+--
+trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
+trivColorable classN conflicts exclusions
+ = let
+ acc r (cd, cf)
+ = case regClass r of
+ RcInteger -> (cd+1, cf)
+ RcDouble -> (cd, cf+1)
+ _ -> panic "MachRegs.trivColorable: reg class not handled"
+
+ tmp = foldUniqSet acc (0, 0) conflicts
+ (rsD, rsFP) = foldUniqSet acc tmp exclusions
+
+ squeese = worst rsD classN RcInteger
+ + worst rsFP classN RcDouble
+
+ in squeese < allocatableRegsInClass classN
+
+
+-- | Worst case displacement
+-- node N of classN has n neighbors of class C.
+--
+-- We currently only have RcInteger and RcDouble, which don't conflict at all.
+-- This is a bit boring compared to what's in RegArchX86.
+--
+worst :: Int -> RegClass -> RegClass -> Int
+worst n classN classC
+ = case classN of
+ RcInteger
+ -> case classC of
+ RcInteger -> min n (allocatableRegsInClass RcInteger)
+ RcDouble -> 0
+
+ RcDouble
+ -> case classC of
+ RcDouble -> min n (allocatableRegsInClass RcDouble)
+ RcInteger -> 0
+
+
-- -----------------------------------------------------------------------------
-- Machine-specific register stuff
fake4 = RealReg 12
fake5 = RealReg 13
+
-- On x86, we might want to have an 8-bit RegClass, which would
-- contain just regs 1-4 (the others don't have 8-bit versions).
-- However, we can get away without this at the moment because the
then regNames !! n
else "%unknown_x86_real_reg_" ++ show n
+
#endif
{-
= let isFree i = isFastTrue (freeReg i)
in filter isFree allMachRegNos
+
+-- | The number of regs in each class.
+-- We go via top level CAFs to ensure that we're not recomputing
+-- the length of these lists each time the fn is called.
+allocatableRegsInClass :: RegClass -> Int
+allocatableRegsInClass cls
+ = case cls of
+ RcInteger -> allocatableRegsInteger
+ RcDouble -> allocatableRegsDouble
+
+allocatableRegsInteger
+ = length $ filter (\r -> regClass r == RcInteger)
+ $ map RealReg allocatableRegs
+
+allocatableRegsDouble
+ = length $ filter (\r -> regClass r == RcDouble)
+ $ map RealReg allocatableRegs
+
+
-- these are the regs which we cannot assume stay alive over a
-- C call.
callClobberedRegs :: [Reg]
freeReg n = fastBool True
--- -----------------------------------------------------------------------------
--- Information about global registers
-
-baseRegOffset :: GlobalReg -> Int
-
-baseRegOffset (VanillaReg 1) = oFFSET_StgRegTable_rR1
-baseRegOffset (VanillaReg 2) = oFFSET_StgRegTable_rR2
-baseRegOffset (VanillaReg 3) = oFFSET_StgRegTable_rR3
-baseRegOffset (VanillaReg 4) = oFFSET_StgRegTable_rR4
-baseRegOffset (VanillaReg 5) = oFFSET_StgRegTable_rR5
-baseRegOffset (VanillaReg 6) = oFFSET_StgRegTable_rR6
-baseRegOffset (VanillaReg 7) = oFFSET_StgRegTable_rR7
-baseRegOffset (VanillaReg 8) = oFFSET_StgRegTable_rR8
-baseRegOffset (VanillaReg 9) = oFFSET_StgRegTable_rR9
-baseRegOffset (VanillaReg 10) = oFFSET_StgRegTable_rR10
-baseRegOffset (FloatReg 1) = oFFSET_StgRegTable_rF1
-baseRegOffset (FloatReg 2) = oFFSET_StgRegTable_rF2
-baseRegOffset (FloatReg 3) = oFFSET_StgRegTable_rF3
-baseRegOffset (FloatReg 4) = oFFSET_StgRegTable_rF4
-baseRegOffset (DoubleReg 1) = oFFSET_StgRegTable_rD1
-baseRegOffset (DoubleReg 2) = oFFSET_StgRegTable_rD2
-baseRegOffset Sp = oFFSET_StgRegTable_rSp
-baseRegOffset SpLim = oFFSET_StgRegTable_rSpLim
-baseRegOffset (LongReg 1) = oFFSET_StgRegTable_rL1
-baseRegOffset Hp = oFFSET_StgRegTable_rHp
-baseRegOffset HpLim = oFFSET_StgRegTable_rHpLim
-baseRegOffset CurrentTSO = oFFSET_StgRegTable_rCurrentTSO
-baseRegOffset CurrentNursery = oFFSET_StgRegTable_rCurrentNursery
-baseRegOffset HpAlloc = oFFSET_StgRegTable_rHpAlloc
-baseRegOffset GCEnter1 = oFFSET_stgGCEnter1
-baseRegOffset GCFun = oFFSET_stgGCFun
-#ifdef DEBUG
-baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
-baseRegOffset _ = panic "baseRegOffset:other"
-#endif
-
-
--- | Returns 'True' if this global register is stored in a caller-saves
--- machine register.
-
-callerSaves :: GlobalReg -> Bool
-
-#ifdef CALLER_SAVES_Base
-callerSaves BaseReg = True
-#endif
-#ifdef CALLER_SAVES_R1
-callerSaves (VanillaReg 1) = True
-#endif
-#ifdef CALLER_SAVES_R2
-callerSaves (VanillaReg 2) = True
-#endif
-#ifdef CALLER_SAVES_R3
-callerSaves (VanillaReg 3) = True
-#endif
-#ifdef CALLER_SAVES_R4
-callerSaves (VanillaReg 4) = True
-#endif
-#ifdef CALLER_SAVES_R5
-callerSaves (VanillaReg 5) = True
-#endif
-#ifdef CALLER_SAVES_R6
-callerSaves (VanillaReg 6) = True
-#endif
-#ifdef CALLER_SAVES_R7
-callerSaves (VanillaReg 7) = True
-#endif
-#ifdef CALLER_SAVES_R8
-callerSaves (VanillaReg 8) = True
-#endif
-#ifdef CALLER_SAVES_F1
-callerSaves (FloatReg 1) = True
-#endif
-#ifdef CALLER_SAVES_F2
-callerSaves (FloatReg 2) = True
-#endif
-#ifdef CALLER_SAVES_F3
-callerSaves (FloatReg 3) = True
-#endif
-#ifdef CALLER_SAVES_F4
-callerSaves (FloatReg 4) = True
-#endif
-#ifdef CALLER_SAVES_D1
-callerSaves (DoubleReg 1) = True
-#endif
-#ifdef CALLER_SAVES_D2
-callerSaves (DoubleReg 2) = True
-#endif
-#ifdef CALLER_SAVES_L1
-callerSaves (LongReg 1) = True
-#endif
-#ifdef CALLER_SAVES_Sp
-callerSaves Sp = True
-#endif
-#ifdef CALLER_SAVES_SpLim
-callerSaves SpLim = True
-#endif
-#ifdef CALLER_SAVES_Hp
-callerSaves Hp = True
-#endif
-#ifdef CALLER_SAVES_HpLim
-callerSaves HpLim = True
-#endif
-#ifdef CALLER_SAVES_CurrentTSO
-callerSaves CurrentTSO = True
-#endif
-#ifdef CALLER_SAVES_CurrentNursery
-callerSaves CurrentNursery = True
-#endif
-callerSaves _ = False
-
-
-- | Returns 'Nothing' if this global register is not stored
-- in a real machine register, otherwise returns @'Just' reg@, where
-- reg is the machine register it is stored in.
projects / ghc-hetmet.git / blobdiff