PPC NCG: Use liveness information in CmmCall
[ghc.git] / compiler / nativeGen / PPC / Regs.hs
index 7a2a84b..7b16f21 100644 (file)
@@ -1,46 +1,47 @@
+{-# LANGUAGE CPP #-}
+
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 1994-2004
--- 
+--
 -- -----------------------------------------------------------------------------
 
 module PPC.Regs (
-       -- 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,
-       sp, r3, r4, r27, r28, f1, f20, f21,
-
-       -- horrow show
-       freeReg,
-       globalRegMaybe,
-       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
 
 )
 
@@ -48,80 +49,78 @@ where
 
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
-#include "../includes/stg/MachRegs.h"
+
+import GhcPrelude
 
 import Reg
 import RegClass
-import Size
+import Format
 
-import BlockId
-import OldCmm
+import Cmm
 import CLabel           ( CLabel )
 import Unique
 
-import Pretty
-import Outputable       ( panic, SDoc )        
-import qualified Outputable
-import Constants
-import FastBool
-import FastTypes
+import CodeGen.Platform
+import DynFlags
+import Outputable
+import Platform
 
-import Data.Word       ( Word8, Word16, Word32 )
-import Data.Int        ( Int8, Int16, Int32 )
+import Data.Word        ( Word8, Word16, Word32, Word64 )
+import Data.Int         ( Int8, Int16, Int32, Int64 )
 
 
 -- squeese functions for the graph allocator -----------------------------------
 
 -- | regSqueeze_class reg
---     Calculuate the maximum number of register colors that could be
---     denied to a node of this class due to having this reg 
---     as a neighbour.
+--      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 -> FastInt
+virtualRegSqueeze :: RegClass -> VirtualReg -> Int
 virtualRegSqueeze cls vr
  = case cls of
-       RcInteger
-        -> case vr of
-               VirtualRegI{}           -> _ILIT(1)
-               VirtualRegHi{}          -> _ILIT(1)
-                _other                  -> _ILIT(0)
+        RcInteger
+         -> case vr of
+                VirtualRegI{}           -> 1
+                VirtualRegHi{}          -> 1
+                _other                  -> 0
 
-       RcDouble
-        -> case vr of
-               VirtualRegD{}           -> _ILIT(1)
-               VirtualRegF{}           -> _ILIT(0)
-                _other                  -> _ILIT(0)
+        RcDouble
+         -> case vr of
+                VirtualRegD{}           -> 1
+                VirtualRegF{}           -> 0
+                _other                  -> 0
 
-        _other -> _ILIT(0)
+        _other -> 0
 
 {-# INLINE realRegSqueeze #-}
-realRegSqueeze :: RegClass -> RealReg -> FastInt
+realRegSqueeze :: RegClass -> RealReg -> Int
 realRegSqueeze cls rr
  = case cls of
-       RcInteger
-        -> case rr of
-               RealRegSingle regNo
-                       | regNo < 32    -> _ILIT(1)     -- first fp reg is 32 
-                       | otherwise     -> _ILIT(0)
-                       
-               RealRegPair{}           -> _ILIT(0)
-
-       RcDouble
-        -> case rr of
-               RealRegSingle regNo
-                       | regNo < 32    -> _ILIT(0)
-                       | otherwise     -> _ILIT(1)
-                       
-               RealRegPair{}           -> _ILIT(0)
-
-        _other -> _ILIT(0)
-
-mkVirtualReg :: Unique -> Size -> VirtualReg
-mkVirtualReg u size
-   | not (isFloatSize size) = VirtualRegI u
+        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 size of
+   = case format of
         FF32    -> VirtualRegD u
         FF64    -> VirtualRegD u
         _       -> panic "mkVirtualReg"
@@ -129,26 +128,28 @@ mkVirtualReg u size
 regDotColor :: RealReg -> SDoc
 regDotColor reg
  = case classOfRealReg reg of
-        RcInteger       -> Outputable.text "blue"
-        RcFloat         -> Outputable.text "red"
-        RcDouble        -> Outputable.text "green"
-        RcDoubleSSE     -> Outputable.text "yellow"
+        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
@@ -164,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
@@ -191,7 +191,7 @@ addrOffset addr off
        | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
        | otherwise     -> Nothing
        where n2 = n + toInteger off
-       
+
       _ -> Nothing
 
 
@@ -200,10 +200,11 @@ 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.
@@ -226,38 +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 classOfRealReg      #-}
 classOfRealReg :: RealReg -> RegClass
 classOfRealReg (RealRegSingle i)
-       | i < 32        = RcInteger 
-       | otherwise     = RcDouble
+        | i < 32        = RcInteger
+        | otherwise     = RcDouble
 
 classOfRealReg (RealRegPair{})
-       = panic "regClass(ppr): no reg pairs on this architecture"
+        = 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
 
@@ -265,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
@@ -283,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
 
 
@@ -310,292 +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 */
-
+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 :: [RealReg]
-allocatableRegs
-   = let isFree i = isFastTrue (freeReg i)
+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"