Patch for shared libraries support on FreeBSD

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

diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs
index 58d063b..ed420a4 100644 (file)
--- a/compiler/nativeGen/X86/RegInfo.hs
+++ b/compiler/nativeGen/X86/RegInfo.hs
@@ -1,16 +1,6 @@
 
 module X86.RegInfo (
-       mkVReg,
-
-        JumpDest, 
-       canShortcut, 
-       shortcutJump, 
-
-       spillSlotSize,
-       maxSpillSlots,
-       spillSlotToOffset,
-       
-       shortcutStatic,
+       mkVirtualReg,
        regDotColor
 )
 
@@ -19,103 +9,36 @@ 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 Constants       ( rESERVED_C_STACK_BYTES )
 import Unique
 
-mkVReg :: Unique -> Size -> Reg
-mkVReg u size
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+import UniqFM
+import X86.Regs
+#endif
+
+
+mkVirtualReg :: Unique -> Size -> VirtualReg
+mkVirtualReg u size
    | not (isFloatSize size) = VirtualRegI u
    | otherwise
    = 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
-
-
-
-spillSlotSize :: Int
-spillSlotSize = IF_ARCH_i386(12, 8)
-
-maxSpillSlots :: Int
-maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
-
--- convert a spill slot number to a *byte* offset, with no sign:
--- decide on a per arch basis whether you are spilling above or below
--- the C stack pointer.
-spillSlotToOffset :: Int -> Int
-spillSlotToOffset slot
-   | slot >= 0 && slot < maxSpillSlots
-   = 64 + spillSlotSize * slot
-   | otherwise
-   = pprPanic "spillSlotToOffset:" 
-              (   text "invalid spill location: " <> int slot
-             $$  text "maxSpillSlots:          " <> int maxSpillSlots)
-
-
--- 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.
-
-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"
-
+       _       -> panic "mkVirtualReg"
 
 
 -- 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")
@@ -133,11 +56,12 @@ regColors
 
 -- reg colors for x86_64
 #elif x86_64_TARGET_ARCH
-regDotColor :: Reg -> SDoc
+regDotColor :: RealReg -> SDoc
 regDotColor reg
  = let Just    str     = lookupUFM regColors reg
    in  text str
 
+regColors :: UniqFM [Char]
 regColors
  = listToUFM
  $     [ (rax, "#00ff00"), (eax, "#00ff00")
@@ -153,7 +77,7 @@ regColors
        , (r14, "#004040")
        , (r15, "#002080") ]
 
-       ++ zip (map RealReg [16..31]) (repeat "red")
+       ++ zip (map regSingle [16..31]) (repeat "red")
 #else
 regDotColor :: Reg -> SDoc
 regDotColor    = panic "not defined"