X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FRegInfo.hs;h=140ff57ae97cdb6e59bd75624695876643de618c;hp=a3bf8e4655e0a196a50b1ac28217f4c4d7f3cba8;hb=013e6f33f55a2ca1a7469b239cac3ae23879299d;hpb=20c0e6ccf28b0961d2c5f6516b57e52fa2c13b33

diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs
index a3bf8e4..140ff57 100644
--- a/compiler/nativeGen/X86/RegInfo.hs
+++ b/compiler/nativeGen/X86/RegInfo.hs
@@ -1,12 +1,6 @@
 
 module X86.RegInfo (
-	mkVReg,
-
-        JumpDest, 
-	canShortcut, 
-	shortcutJump, 
-	
-	shortcutStatic,
+	mkVirtualReg,
 	regDotColor
 )
 
@@ -15,128 +9,68 @@ where
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
 
-import X86.Instr
-import X86.Cond
-import X86.Regs
 import Size
 import Reg
 
-import Cmm
-import CLabel
-import BlockId
 import Outputable
+import Platform
 import Unique
 
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 import UniqFM
-#endif
+import X86.Regs
 
 
-mkVReg :: Unique -> Size -> Reg
-mkVReg u size
-   | not (isFloatSize size) = VirtualRegI u
-   | otherwise
+mkVirtualReg :: Unique -> Size -> VirtualReg
+mkVirtualReg u size
    = case size of
-        FF32	-> VirtualRegD u
-        FF64	-> VirtualRegD u
-	_	-> panic "mkVReg"
-
-
-data JumpDest = DestBlockId BlockId | DestImm Imm
-
-
-canShortcut :: Instr -> Maybe JumpDest
-canShortcut (JXX ALWAYS id) 	= Just (DestBlockId id)
-canShortcut (JMP (OpImm imm)) 	= Just (DestImm imm)
-canShortcut _ 			= Nothing
-
-
-shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
-shortcutJump fn insn@(JXX cc id) = 
-  case fn id of
-    Nothing                -> insn
-    Just (DestBlockId id') -> shortcutJump fn (JXX cc id')
-    Just (DestImm imm)     -> shortcutJump fn (JXX_GBL cc imm)
-
-shortcutJump _ other = other
-
-
--- Here because it knows about JumpDest
-shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
-shortcutStatic fn (CmmStaticLit (CmmLabel lab))
-  | Just uq <- maybeAsmTemp lab 
-  = CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
-shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
-  | Just uq <- maybeAsmTemp lbl1
-  = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
-        -- slightly dodgy, we're ignoring the second label, but this
-        -- works with the way we use CmmLabelDiffOff for jump tables now.
+        FF32	-> VirtualRegSSE u
+        FF64	-> VirtualRegSSE u
+        FF80	-> VirtualRegD   u
+        _other  -> VirtualRegI   u
 
-shortcutStatic _ other_static
-        = other_static
-
-shortBlockId 
-	:: (BlockId -> Maybe JumpDest)
-	-> BlockId
-	-> CLabel
-
-shortBlockId fn blockid@(BlockId uq) =
-   case fn blockid of
-      Nothing -> mkAsmTempLabel uq
-      Just (DestBlockId blockid')  -> shortBlockId fn blockid'
-      Just (DestImm (ImmCLbl lbl)) -> lbl
-      _other -> panic "shortBlockId"
-
-
-
--- reg colors for x86
-#if i386_TARGET_ARCH
-regDotColor :: Reg -> SDoc
+regDotColor :: RealReg -> SDoc
 regDotColor reg
  = let	Just	str	= lookupUFM regColors reg
    in	text str
 
 regColors :: UniqFM [Char]
-regColors
- = listToUFM
- $  	[ (eax,	"#00ff00")
-	, (ebx,	"#0000ff")
-	, (ecx,	"#00ffff")
-	, (edx,	"#0080ff")
-
-	, (fake0, "#ff00ff")
+regColors = listToUFM (normalRegColors ++ fpRegColors)
+
+-- TODO: We shouldn't be using defaultTargetPlatform here.
+--       We should be passing DynFlags in instead, and looking at
+--       its targetPlatform.
+
+normalRegColors :: [(Reg,String)]
+normalRegColors = case platformArch defaultTargetPlatform of
+                  ArchX86 -> [ (eax, "#00ff00")
+                             , (ebx, "#0000ff")
+                             , (ecx, "#00ffff")
+                             , (edx, "#0080ff") ]
+                  ArchX86_64 -> [ (rax, "#00ff00"), (eax, "#00ff00")
+                                , (rbx, "#0000ff"), (ebx, "#0000ff")
+                                , (rcx, "#00ffff"), (ecx, "#00ffff")
+                                , (rdx, "#0080ff"), (edx, "#00ffff")
+                                , (r8,  "#00ff80")
+                                , (r9,  "#008080")
+                                , (r10, "#0040ff")
+                                , (r11, "#00ff40")
+                                , (r12, "#008040")
+                                , (r13, "#004080")
+                                , (r14, "#004040")
+                                , (r15, "#002080") ]
+                  ArchPPC     -> panic "X86 normalRegColors ArchPPC"
+                  ArchPPC_64  -> panic "X86 normalRegColors ArchPPC_64"
+                  ArchSPARC   -> panic "X86 normalRegColors ArchSPARC"
+                  ArchUnknown -> panic "X86 normalRegColors ArchUnknown"
+
+fpRegColors :: [(Reg,String)]
+fpRegColors =
+        [ (fake0, "#ff00ff")
 	, (fake1, "#ff00aa")
 	, (fake2, "#aa00ff")
 	, (fake3, "#aa00aa")
 	, (fake4, "#ff0055")
 	, (fake5, "#5500ff") ]
 
+	++ zip (map regSingle [24..39]) (repeat "red")
 
--- reg colors for x86_64
-#elif x86_64_TARGET_ARCH
-regDotColor :: Reg -> SDoc
-regDotColor reg
- = let	Just	str	= lookupUFM regColors reg
-   in	text str
-
-regColors :: UniqFM [Char]
-regColors
- = listToUFM
- $	[ (rax, "#00ff00"), (eax, "#00ff00")
-	, (rbx,	"#0000ff"), (ebx, "#0000ff")
-	, (rcx,	"#00ffff"), (ecx, "#00ffff")
-	, (rdx,	"#0080ff"), (edx, "#00ffff")
-	, (r8,  "#00ff80")
-	, (r9,  "#008080")
-	, (r10, "#0040ff")
-	, (r11, "#00ff40")
-	, (r12, "#008040")
-	, (r13, "#004080")
-	, (r14, "#004040")
-	, (r15, "#002080") ]
-
-	++ zip (map RealReg [16..31]) (repeat "red")
-#else
-regDotColor :: Reg -> SDoc
-regDotColor	= panic "not defined"
-#endif