X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPPC%2FRegs.hs;h=7a2a84b68c9020d4eed2b24f39ae886b438c7399;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hp=c39313a6f2f5bd454122b19b93d3597450358c3f;hpb=f9288086f935c97812b2d80defcff38baf7b6a6c;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index c39313a..7a2a84b 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -5,6 +5,13 @@
 -- -----------------------------------------------------------------------------
 
 module PPC.Regs (
+	-- squeeze functions
+	virtualRegSqueeze,
+	realRegSqueeze,
+
+	mkVirtualReg,
+	regDotColor,
+
 	-- immediates
 	Imm(..),
 	strImmLit,
@@ -20,7 +27,7 @@ module PPC.Regs (
 	allArgRegs,
 	callClobberedRegs,
 	allMachRegNos,
-	regClass,
+	classOfRealReg,
 	showReg,
 	
 	-- machine specific
@@ -33,7 +40,6 @@ module PPC.Regs (
 	-- horrow show
 	freeReg,
 	globalRegMaybe,
-	get_GlobalReg_reg_or_addr,
 	allocatableRegs
 
 )
@@ -42,25 +48,93 @@ where
 
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
-#include "../includes/MachRegs.h"
+#include "../includes/stg/MachRegs.h"
 
 import Reg
 import RegClass
+import Size
 
-import CgUtils          ( get_GlobalReg_addr )
 import BlockId
-import Cmm
+import OldCmm
 import CLabel           ( CLabel )
+import Unique
+
 import Pretty
-import Outputable	( Outputable(..), pprPanic, panic )
+import Outputable       ( panic, SDoc )	
 import qualified Outputable
 import Constants
 import FastBool
+import FastTypes
 
 import Data.Word	( Word8, Word16, Word32 )
 import Data.Int 	( Int8, Int16, Int32 )
 
 
+-- 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.
+--
+{-# INLINE virtualRegSqueeze #-}
+virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
+virtualRegSqueeze cls vr
+ = case cls of
+ 	RcInteger
+	 -> case vr of
+	 	VirtualRegI{}		-> _ILIT(1)
+		VirtualRegHi{}		-> _ILIT(1)
+                _other                  -> _ILIT(0)
+
+	RcDouble
+	 -> case vr of
+		VirtualRegD{}		-> _ILIT(1)
+		VirtualRegF{}		-> _ILIT(0)
+                _other                  -> _ILIT(0)
+
+        _other -> _ILIT(0)
+
+{-# INLINE realRegSqueeze #-}
+realRegSqueeze :: RegClass -> RealReg -> FastInt
+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
+   | otherwise
+   = case size of
+        FF32    -> VirtualRegD u
+        FF64    -> VirtualRegD u
+        _       -> panic "mkVirtualReg"
+
+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"
+
+
 -- immediates ------------------------------------------------------------------
 data Imm
 	= ImmInt	Int
@@ -135,7 +209,6 @@ spRel n	= AddrRegImm sp (ImmInt (n * wORD_SIZE))
 -- 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]
@@ -173,18 +246,13 @@ 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
-
-regClass (RegReal    (RealRegSingle i))
+{-# INLINE classOfRealReg      #-}
+classOfRealReg :: RealReg -> RegClass
+classOfRealReg (RealRegSingle i)
 	| i < 32	= RcInteger 
 	| otherwise	= RcDouble
 
-regClass (RegReal    (RealRegPair{}))
+classOfRealReg (RealRegPair{})
 	= panic "regClass(ppr): no reg pairs on this architecture"
 
 showReg :: RegNo -> String
@@ -524,24 +592,10 @@ 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)
-
-
 -- 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 :: [RealReg]
 allocatableRegs
    = let isFree i = isFastTrue (freeReg i)
-     in  filter isFree allMachRegNos
+     in  map RealRegSingle $ filter isFree allMachRegNos