PPC NCG: Use liveness information in CmmCall
[ghc.git] / compiler / nativeGen / PPC / Regs.hs
index c39313a..7b16f21 100644 (file)
@@ -1,40 +1,47 @@
+{-# LANGUAGE CPP #-}
+
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 1994-2004
--- 
+--
 -- -----------------------------------------------------------------------------
 
 module PPC.Regs (
-       -- immediates
-       Imm(..),
-       strImmLit,
-       litToImm,
-
-       -- addressing modes
-       AddrMode(..),
-       addrOffset,
-
-       -- registers
-       spRel,
-       argRegs,
-       allArgRegs,
-       callClobberedRegs,
-       allMachRegNos,
-       regClass,
-       showReg,
-       
-       -- machine specific
-       allFPArgRegs,
-       fits16Bits,
-       makeImmediate,
-       fReg,
-       sp, r3, r4, r27, r28, f1, f20, f21,
-
-       -- horrow show
-       freeReg,
-       globalRegMaybe,
-       get_GlobalReg_reg_or_addr,
-       allocatableRegs
+        -- squeeze functions
+        virtualRegSqueeze,
+        realRegSqueeze,
+
+        mkVirtualReg,
+        regDotColor,
+
+        -- immediates
+        Imm(..),
+        strImmLit,
+        litToImm,
+
+        -- addressing modes
+        AddrMode(..),
+        addrOffset,
+
+        -- registers
+        spRel,
+        argRegs,
+        allArgRegs,
+        callClobberedRegs,
+        allMachRegNos,
+        classOfRealReg,
+        showReg,
+
+        -- machine specific
+        allFPArgRegs,
+        fits16Bits,
+        makeImmediate,
+        fReg,
+        r0, sp, toc, r3, r4, r11, r12, r30,
+        tmpReg,
+        f1,
+
+        allocatableRegs
 
 )
 
@@ -42,39 +49,107 @@ where
 
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
-#include "../includes/MachRegs.h"
+
+import GhcPrelude
 
 import Reg
 import RegClass
+import Format
 
-import CgUtils          ( get_GlobalReg_addr )
-import BlockId
 import Cmm
 import CLabel           ( CLabel )
-import Pretty
-import Outputable      ( Outputable(..), pprPanic, panic )
-import qualified Outputable
-import Constants
-import FastBool
+import Unique
 
-import Data.Word       ( Word8, Word16, Word32 )
-import Data.Int        ( Int8, Int16, Int32 )
+import CodeGen.Platform
+import DynFlags
+import Outputable
+import Platform
+
+import Data.Word        ( Word8, Word16, Word32, Word64 )
+import Data.Int         ( Int8, Int16, Int32, Int64 )
+
+
+-- squeese functions for the graph allocator -----------------------------------
+
+-- | regSqueeze_class reg
+--      Calculate the maximum number of register colors that could be
+--      denied to a node of this class due to having this reg
+--      as a neighbour.
+--
+{-# INLINE virtualRegSqueeze #-}
+virtualRegSqueeze :: RegClass -> VirtualReg -> Int
+virtualRegSqueeze cls vr
+ = case cls of
+        RcInteger
+         -> case vr of
+                VirtualRegI{}           -> 1
+                VirtualRegHi{}          -> 1
+                _other                  -> 0
+
+        RcDouble
+         -> case vr of
+                VirtualRegD{}           -> 1
+                VirtualRegF{}           -> 0
+                _other                  -> 0
+
+        _other -> 0
+
+{-# INLINE realRegSqueeze #-}
+realRegSqueeze :: RegClass -> RealReg -> Int
+realRegSqueeze cls rr
+ = case cls of
+        RcInteger
+         -> case rr of
+                RealRegSingle regNo
+                        | regNo < 32    -> 1     -- first fp reg is 32
+                        | otherwise     -> 0
+
+                RealRegPair{}           -> 0
+
+        RcDouble
+         -> case rr of
+                RealRegSingle regNo
+                        | regNo < 32    -> 0
+                        | otherwise     -> 1
+
+                RealRegPair{}           -> 0
+
+        _other -> 0
+
+mkVirtualReg :: Unique -> Format -> VirtualReg
+mkVirtualReg u format
+   | not (isFloatFormat format) = VirtualRegI u
+   | otherwise
+   = case format of
+        FF32    -> VirtualRegD u
+        FF64    -> VirtualRegD u
+        _       -> panic "mkVirtualReg"
+
+regDotColor :: RealReg -> SDoc
+regDotColor reg
+ = case classOfRealReg reg of
+        RcInteger       -> text "blue"
+        RcFloat         -> text "red"
+        RcDouble        -> text "green"
+        RcDoubleSSE     -> text "yellow"
 
 
 -- immediates ------------------------------------------------------------------
 data Imm
-       = ImmInt        Int
-       | ImmInteger    Integer     -- Sigh.
-       | ImmCLbl       CLabel      -- AbstractC Label (with baggage)
-       | ImmLit        Doc         -- Simple string
-       | ImmIndex    CLabel Int
-       | ImmFloat      Rational
-       | ImmDouble     Rational
-       | ImmConstantSum Imm Imm
-       | ImmConstantDiff Imm Imm
-       | LO Imm
-       | HI Imm
-       | HA Imm        {- high halfword adjusted -}
+        = ImmInt        Int
+        | ImmInteger    Integer     -- Sigh.
+        | ImmCLbl       CLabel      -- AbstractC Label (with baggage)
+        | ImmLit        SDoc        -- Simple string
+        | ImmIndex    CLabel Int
+        | ImmFloat      Rational
+        | ImmDouble     Rational
+        | ImmConstantSum Imm Imm
+        | ImmConstantDiff Imm Imm
+        | LO Imm
+        | HI Imm
+        | HA Imm        {- high halfword adjusted -}
+        | HIGHERA Imm
+        | HIGHESTA Imm
 
 
 strImmLit :: String -> Imm
@@ -90,19 +165,18 @@ litToImm (CmmFloat f W32)    = ImmFloat f
 litToImm (CmmFloat f W64)    = ImmDouble f
 litToImm (CmmLabel l)        = ImmCLbl l
 litToImm (CmmLabelOff l off) = ImmIndex l off
-litToImm (CmmLabelDiffOff l1 l2 off)
+litToImm (CmmLabelDiffOff l1 l2 off _)
                              = ImmConstantSum
                                (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
                                (ImmInt off)
-litToImm (CmmBlock id)       = ImmCLbl (infoTblLbl id)
 litToImm _                   = panic "PPC.Regs.litToImm: no match"
 
 
 -- addressing modes ------------------------------------------------------------
 
 data AddrMode
-       = AddrRegReg    Reg Reg
-       | AddrRegImm    Reg Imm
+        = AddrRegReg    Reg Reg
+        | AddrRegImm    Reg Imm
 
 
 addrOffset :: AddrMode -> Int -> Maybe AddrMode
@@ -117,7 +191,7 @@ addrOffset addr off
        | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
        | otherwise     -> Nothing
        where n2 = n + toInteger off
-       
+
       _ -> Nothing
 
 
@@ -126,16 +200,16 @@ addrOffset addr off
 -- temporaries and for excess call arguments.  @fpRel@, where
 -- applicable, is the same but for the frame pointer.
 
-spRel :: Int   -- desired stack offset in words, positive or negative
+spRel :: DynFlags
+      -> Int    -- desired stack offset in words, positive or negative
       -> AddrMode
 
-spRel n        = AddrRegImm sp (ImmInt (n * wORD_SIZE))
+spRel dflags n = AddrRegImm sp (ImmInt (n * wORD_SIZE dflags))
 
 
 -- argRegs is the set of regs which are read for an n-argument call to C.
 -- For archs which pass all args on the stack (x86), is empty.
 -- Sparc passes up to the first 6 args in regs.
--- Dunno about Alpha.
 argRegs :: RegNo -> [Reg]
 argRegs 0 = []
 argRegs 1 = map regSingle [3]
@@ -153,43 +227,28 @@ allArgRegs :: [Reg]
 allArgRegs = map regSingle [3..10]
 
 
--- these are the regs which we cannot assume stay alive over a C call.  
-callClobberedRegs :: [Reg]
-#if   defined(darwin_TARGET_OS)
-callClobberedRegs
+-- these are the regs which we cannot assume stay alive over a C call.
+callClobberedRegs :: Platform -> [Reg]
+callClobberedRegs _platform
   = map regSingle (0:[2..12] ++ map fReg [0..13])
 
-#elif defined(linux_TARGET_OS)
-callClobberedRegs
-  = map regSingle (0:[2..13] ++ map fReg [0..13])
-
-#else
-callClobberedRegs
-       = panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
-#endif
-
 
-allMachRegNos  :: [RegNo]
-allMachRegNos  = [0..63]
+allMachRegNos   :: [RegNo]
+allMachRegNos   = [0..63]
 
 
-{-# INLINE regClass      #-}
-regClass :: Reg -> RegClass
-regClass (RegVirtual (VirtualRegI  _)) = RcInteger
-regClass (RegVirtual (VirtualRegHi _)) = RcInteger
-regClass (RegVirtual (VirtualRegF  u)) = pprPanic ("regClass(ppc):VirtualRegF ") (ppr u)
-regClass (RegVirtual (VirtualRegD  _)) = RcDouble
+{-# INLINE classOfRealReg      #-}
+classOfRealReg :: RealReg -> RegClass
+classOfRealReg (RealRegSingle i)
+        | i < 32        = RcInteger
+        | otherwise     = RcDouble
 
-regClass (RegReal    (RealRegSingle i))
-       | i < 32        = RcInteger 
-       | otherwise     = RcDouble
-
-regClass (RegReal    (RealRegPair{}))
-       = panic "regClass(ppr): no reg pairs on this architecture"
+classOfRealReg (RealRegPair{})
+        = panic "regClass(ppr): no reg pairs on this architecture"
 
 showReg :: RegNo -> String
 showReg n
-    | n >= 0 && n <= 31          = "%r" ++ show n
+    | n >= 0 && n <= 31   = "%r" ++ show n
     | n >= 32 && n <= 63  = "%f" ++ show (n - 32)
     | otherwise           = "%unknown_powerpc_real_reg_" ++ show n
 
@@ -197,17 +256,14 @@ showReg n
 
 -- machine specific ------------------------------------------------------------
 
-allFPArgRegs :: [Reg]
-#if    defined(darwin_TARGET_OS)
-allFPArgRegs = map (regSingle . fReg) [1..13]
-
-#elif  defined(linux_TARGET_OS)
-allFPArgRegs = map (regSingle . fReg) [1..8]
-
-#else
-allFPArgRegs = panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
-
-#endif
+allFPArgRegs :: Platform -> [Reg]
+allFPArgRegs platform
+    = case platformOS platform of
+      OSAIX    -> map (regSingle . fReg) [1..13]
+      _        -> case platformArch platform of
+        ArchPPC      -> map (regSingle . fReg) [1..8]
+        ArchPPC_64 _ -> map (regSingle . fReg) [1..13]
+        _            -> panic "PPC.Regs.allFPArgRegs: unknown PPC Linux"
 
 fits16Bits :: Integral a => a -> Bool
 fits16Bits x = x >= -32768 && x < 32768
@@ -215,22 +271,30 @@ fits16Bits x = x >= -32768 && x < 32768
 makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
 makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
     where
+        narrow W64 False = fromIntegral (fromIntegral x :: Word64)
         narrow W32 False = fromIntegral (fromIntegral x :: Word32)
         narrow W16 False = fromIntegral (fromIntegral x :: Word16)
         narrow W8  False = fromIntegral (fromIntegral x :: Word8)
+        narrow W64 True  = fromIntegral (fromIntegral x :: Int64)
         narrow W32 True  = fromIntegral (fromIntegral x :: Int32)
         narrow W16 True  = fromIntegral (fromIntegral x :: Int16)
         narrow W8  True  = fromIntegral (fromIntegral x :: Int8)
-       narrow _   _     = panic "PPC.Regs.narrow: no match"
-        
+        narrow _   _     = panic "PPC.Regs.narrow: no match"
+
         narrowed = narrow rep signed
-        
+
         toI16 W32 True
             | narrowed >= -32768 && narrowed < 32768 = Just narrowed
             | otherwise = Nothing
         toI16 W32 False
             | narrowed >= 0 && narrowed < 65536 = Just narrowed
             | otherwise = Nothing
+        toI16 W64 True
+            | narrowed >= -32768 && narrowed < 32768 = Just narrowed
+            | otherwise = Nothing
+        toI16 W64 False
+            | narrowed >= 0 && narrowed < 65536 = Just narrowed
+            | otherwise = Nothing
         toI16 _ _  = Just narrowed
 
 
@@ -242,306 +306,29 @@ point registers.
 fReg :: Int -> RegNo
 fReg x = (32 + x)
 
-sp, r3, r4, r27, r28, f1, f20, f21 :: Reg
-sp     = regSingle 1
-r3     = regSingle 3
-r4     = regSingle 4
-r27    = regSingle 27
-r28    = regSingle 28
-f1     = regSingle $ fReg 1
-f20    = regSingle $ fReg 20
-f21    = regSingle $ fReg 21
-
-
-
--- horror show -----------------------------------------------------------------
-freeReg :: RegNo -> FastBool
-globalRegMaybe :: GlobalReg -> Maybe Reg
-
-
-#if powerpc_TARGET_ARCH
-#define r0 0
-#define r1 1
-#define r2 2
-#define r3 3
-#define r4 4
-#define r5 5
-#define r6 6
-#define r7 7
-#define r8 8
-#define r9 9
-#define r10 10
-#define r11 11
-#define r12 12
-#define r13 13
-#define r14 14
-#define r15 15
-#define r16 16
-#define r17 17
-#define r18 18
-#define r19 19
-#define r20 20
-#define r21 21
-#define r22 22
-#define r23 23
-#define r24 24
-#define r25 25
-#define r26 26
-#define r27 27
-#define r28 28
-#define r29 29
-#define r30 30
-#define r31 31
-
-#ifdef darwin_TARGET_OS
-#define f0  32
-#define f1  33
-#define f2  34
-#define f3  35
-#define f4  36
-#define f5  37
-#define f6  38
-#define f7  39
-#define f8  40
-#define f9  41
-#define f10 42
-#define f11 43
-#define f12 44
-#define f13 45
-#define f14 46
-#define f15 47
-#define f16 48
-#define f17 49
-#define f18 50
-#define f19 51
-#define f20 52
-#define f21 53
-#define f22 54
-#define f23 55
-#define f24 56
-#define f25 57
-#define f26 58
-#define f27 59
-#define f28 60
-#define f29 61
-#define f30 62
-#define f31 63
-#else
-#define fr0  32
-#define fr1  33
-#define fr2  34
-#define fr3  35
-#define fr4  36
-#define fr5  37
-#define fr6  38
-#define fr7  39
-#define fr8  40
-#define fr9  41
-#define fr10 42
-#define fr11 43
-#define fr12 44
-#define fr13 45
-#define fr14 46
-#define fr15 47
-#define fr16 48
-#define fr17 49
-#define fr18 50
-#define fr19 51
-#define fr20 52
-#define fr21 53
-#define fr22 54
-#define fr23 55
-#define fr24 56
-#define fr25 57
-#define fr26 58
-#define fr27 59
-#define fr28 60
-#define fr29 61
-#define fr30 62
-#define fr31 63
-#endif
-
-
-
-freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free
-freeReg 1 = fastBool False -- The Stack Pointer
-#if !darwin_TARGET_OS
- -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
-freeReg 2 = fastBool False
-#endif
-
-#ifdef REG_Base
-freeReg REG_Base = fastBool False
-#endif
-#ifdef REG_R1
-freeReg REG_R1   = fastBool False
-#endif 
-#ifdef REG_R2  
-freeReg REG_R2   = fastBool False
-#endif 
-#ifdef REG_R3  
-freeReg REG_R3   = fastBool False
-#endif 
-#ifdef REG_R4  
-freeReg REG_R4   = fastBool False
-#endif 
-#ifdef REG_R5  
-freeReg REG_R5   = fastBool False
-#endif 
-#ifdef REG_R6  
-freeReg REG_R6   = fastBool False
-#endif 
-#ifdef REG_R7  
-freeReg REG_R7   = fastBool False
-#endif 
-#ifdef REG_R8  
-freeReg REG_R8   = fastBool False
-#endif
-#ifdef REG_F1
-freeReg REG_F1 = fastBool False
-#endif
-#ifdef REG_F2
-freeReg REG_F2 = fastBool False
-#endif
-#ifdef REG_F3
-freeReg REG_F3 = fastBool False
-#endif
-#ifdef REG_F4
-freeReg REG_F4 = fastBool False
-#endif
-#ifdef REG_D1
-freeReg REG_D1 = fastBool False
-#endif
-#ifdef REG_D2
-freeReg REG_D2 = fastBool False
-#endif
-#ifdef REG_Sp 
-freeReg REG_Sp   = fastBool False
-#endif 
-#ifdef REG_Su
-freeReg REG_Su   = fastBool False
-#endif 
-#ifdef REG_SpLim 
-freeReg REG_SpLim = fastBool False
-#endif 
-#ifdef REG_Hp 
-freeReg REG_Hp   = fastBool False
-#endif
-#ifdef REG_HpLim
-freeReg REG_HpLim = fastBool False
-#endif
-freeReg _               = fastBool True
-
-
---  | 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.
-
-
-#ifdef REG_Base
-globalRegMaybe BaseReg                 = Just (regSingle REG_Base)
-#endif
-#ifdef REG_R1
-globalRegMaybe (VanillaReg 1 _)                = Just (regSingle REG_R1)
-#endif 
-#ifdef REG_R2 
-globalRegMaybe (VanillaReg 2 _)                = Just (regSingle REG_R2)
-#endif 
-#ifdef REG_R3 
-globalRegMaybe (VanillaReg 3 _)        = Just (regSingle REG_R3)
-#endif 
-#ifdef REG_R4 
-globalRegMaybe (VanillaReg 4 _)                = Just (regSingle REG_R4)
-#endif 
-#ifdef REG_R5 
-globalRegMaybe (VanillaReg 5 _)                = Just (regSingle REG_R5)
-#endif 
-#ifdef REG_R6 
-globalRegMaybe (VanillaReg 6 _)                = Just (regSingle REG_R6)
-#endif 
-#ifdef REG_R7 
-globalRegMaybe (VanillaReg 7 _)                = Just (regSingle REG_R7)
-#endif 
-#ifdef REG_R8 
-globalRegMaybe (VanillaReg 8 _)                = Just (regSingle REG_R8)
-#endif
-#ifdef REG_R9 
-globalRegMaybe (VanillaReg 9 _)                = Just (regSingle REG_R9)
-#endif
-#ifdef REG_R10 
-globalRegMaybe (VanillaReg 10 _)       = Just (regSingle REG_R10)
-#endif
-#ifdef REG_F1
-globalRegMaybe (FloatReg 1)            = Just (regSingle REG_F1)
-#endif                                 
-#ifdef REG_F2                          
-globalRegMaybe (FloatReg 2)            = Just (regSingle REG_F2)
-#endif                                 
-#ifdef REG_F3                          
-globalRegMaybe (FloatReg 3)            = Just (regSingle REG_F3)
-#endif                                 
-#ifdef REG_F4                          
-globalRegMaybe (FloatReg 4)            = Just (regSingle REG_F4)
-#endif                                 
-#ifdef REG_D1                          
-globalRegMaybe (DoubleReg 1)           = Just (regSingle REG_D1)
-#endif                                 
-#ifdef REG_D2                          
-globalRegMaybe (DoubleReg 2)           = Just (regSingle REG_D2)
-#endif
-#ifdef REG_Sp      
-globalRegMaybe Sp                      = Just (regSingle REG_Sp)
-#endif
-#ifdef REG_Lng1                                
-globalRegMaybe (LongReg 1)             = Just (regSingle REG_Lng1)
-#endif                                 
-#ifdef REG_Lng2                                
-globalRegMaybe (LongReg 2)             = Just (regSingle REG_Lng2)
-#endif
-#ifdef REG_SpLim                               
-globalRegMaybe SpLim                   = Just (regSingle REG_SpLim)
-#endif                                 
-#ifdef REG_Hp                          
-globalRegMaybe Hp                      = Just (regSingle REG_Hp)
-#endif                                 
-#ifdef REG_HpLim                       
-globalRegMaybe HpLim                   = Just (regSingle REG_HpLim)
-#endif                                 
-#ifdef REG_CurrentTSO                          
-globalRegMaybe CurrentTSO              = Just (regSingle REG_CurrentTSO)
-#endif                                 
-#ifdef REG_CurrentNursery                              
-globalRegMaybe CurrentNursery          = Just (regSingle REG_CurrentNursery)
-#endif                                 
-globalRegMaybe _                       = Nothing
-
-
-#else  /* powerpc_TARGET_ARCH */
-
-freeReg _              = 0#
-globalRegMaybe _       = panic "PPC.Regs.globalRegMaybe: not defined"
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- 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 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_reg_or_addr mid
-   = case globalRegMaybe mid of
-        Just rr -> Left rr
-        Nothing -> Right (get_GlobalReg_addr mid)
-
+r0, sp, toc, r3, r4, r11, r12, r30, f1 :: Reg
+r0      = regSingle 0
+sp      = regSingle 1
+toc     = regSingle 2
+r3      = regSingle 3
+r4      = regSingle 4
+r11     = regSingle 11
+r12     = regSingle 12
+r30     = regSingle 30
+f1      = regSingle $ fReg 1
 
 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
 -- i.e., these are the regs for which we are prepared to allow the
 -- register allocator to attempt to map VRegs to.
-allocatableRegs :: [RegNo]
-allocatableRegs
-   = let isFree i = isFastTrue (freeReg i)
-     in  filter isFree allMachRegNos
+allocatableRegs :: Platform -> [RealReg]
+allocatableRegs platform
+   = let isFree i = freeReg platform i
+     in  map RealRegSingle $ filter isFree allMachRegNos
+
+-- temporary register for compiler use
+tmpReg :: Platform -> Reg
+tmpReg platform =
+       case platformArch platform of
+       ArchPPC      -> regSingle 13
+       ArchPPC_64 _ -> regSingle 30
+       _            -> panic "PPC.Regs.tmpReg: unknown arch"