Fix a build failure on non-{x86,amd64}

[ghc-hetmet.git] / compiler / nativeGen / X86 / RegInfo.hs

diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs
index f47859e..140ff57 100644 (file)
--- a/compiler/nativeGen/X86/RegInfo.hs
+++ b/compiler/nativeGen/X86/RegInfo.hs
@@ -9,76 +9,68 @@ where
 #include "nativeGen/NCG.h"
 #include "HsVersions.h"
 
-import X86.Regs
 import Size
 import Reg
 
 import Outputable
+import Platform
 import Unique
 
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 import UniqFM
-#endif
+import X86.Regs
 
 
 mkVirtualReg :: Unique -> Size -> VirtualReg
 mkVirtualReg u size
-   | not (isFloatSize size) = VirtualRegI u
-   | otherwise
    = case size of
-        FF32   -> VirtualRegD u
-        FF64   -> VirtualRegD u
-       _       -> panic "mkVirtualReg"
-
+        FF32   -> VirtualRegSSE u
+        FF64   -> VirtualRegSSE u
+        FF80   -> VirtualRegD   u
+        _other  -> VirtualRegI   u
 
--- reg colors for x86
-#if i386_TARGET_ARCH
 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 :: RealReg -> 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