Patch for shared libraries support on FreeBSD

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

diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 26da907..6dc229b 100644 (file)
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -18,6 +18,7 @@ import Instruction
 import Size
 import RegClass
 import Reg
+import TargetReg
 
 import BlockId
 import Cmm
@@ -27,7 +28,8 @@ import Outputable
 import Constants       (rESERVED_C_STACK_BYTES)
 
 import CLabel
-import Panic
+import UniqSet
+import Unique
 
 -- Size of a PPC memory address, in bytes.
 --
@@ -443,12 +445,9 @@ x86_regUsageOfInstr instr
              dst' = filter interesting dst
 
 interesting :: Reg -> Bool
-interesting (VirtualRegI  _)  = True
-interesting (VirtualRegHi _)  = True
-interesting (VirtualRegF  _)  = True
-interesting (VirtualRegD  _)  = True
-interesting (RealReg i)       = isFastTrue (freeReg i)
-
+interesting (RegVirtual _)             = True
+interesting (RegReal (RealRegSingle i))        = isFastTrue (freeReg i)
+interesting (RegReal (RealRegPair{}))  = panic "X86.interesting: no reg pairs on this arch"
 
 
 
@@ -608,7 +607,7 @@ x86_mkSpillInstr reg delta slot
   = let        off     = spillSlotToOffset slot
     in
     let off_w = (off-delta) `div` 4
-    in case regClass reg of
+    in case targetClassOfReg reg of
           RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w))
           _         -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -}
 
@@ -617,7 +616,7 @@ x86_mkSpillInstr reg delta slot
   = let        off     = spillSlotToOffset slot
     in
     let off_w = (off-delta) `div` 8
-    in case regClass reg of
+    in case targetClassOfReg reg of
           RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w))
           RcDouble  -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w))
            _         -> panic "X86.mkSpillInstr: no match"
@@ -641,7 +640,7 @@ x86_mkLoadInstr reg delta slot
   = let off     = spillSlotToOffset slot
     in
        let off_w = (off-delta) `div` 4
-        in case regClass reg of {
+        in case targetClassOfReg reg of {
               RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg);
               _         -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -}
 #elif x86_64_TARGET_ARCH
@@ -649,7 +648,7 @@ x86_mkLoadInstr reg delta slot
   = let off     = spillSlotToOffset slot
     in
        let off_w = (off-delta) `div` 8
-        in case regClass reg of
+        in case targetClassOfReg reg of
               RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg)
               _         -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg)
 #else
@@ -713,7 +712,7 @@ x86_mkRegRegMoveInstr
        -> Instr
 
 x86_mkRegRegMoveInstr src dst
- = case regClass src of
+ = case targetClassOfReg src of
 #if   i386_TARGET_ARCH
         RcInteger -> MOV II32 (OpReg src) (OpReg dst)
         RcDouble  -> GMOV src dst
@@ -796,3 +795,54 @@ is_G_instr instr
        GTAN{}          -> True
         GFREE          -> panic "is_G_instr: GFREE (!)"
         _              -> False
+
+
+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
+
+
+-- This helper shortcuts a sequence of branches.
+-- The blockset helps avoid following cycles.
+shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
+shortcutJump fn insn = shortcutJump' fn emptyBlockSet insn
+  where shortcutJump' fn seen insn@(JXX cc id) =
+          if elemBlockSet id seen then insn
+          else case fn id of
+                 Nothing                -> insn
+                 Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')
+                 Just (DestImm imm)     -> shortcutJump' fn seen' (JXX_GBL cc imm)
+               where seen' = extendBlockSet seen id
+        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 emptyUniqSet (BlockId uq)))
+shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
+  | Just uq <- maybeAsmTemp lbl1
+  = CmmStaticLit (CmmLabelDiffOff (shortBlockId fn emptyUniqSet (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)
+       -> UniqSet Unique
+       -> BlockId
+       -> CLabel
+
+shortBlockId fn seen blockid@(BlockId uq) =
+  case (elementOfUniqSet uq seen, fn blockid) of
+    (True, _)    -> mkAsmTempLabel uq
+    (_, Nothing) -> mkAsmTempLabel uq
+    (_, Just (DestBlockId blockid'))  -> shortBlockId fn (addOneToUniqSet seen uq) blockid'
+    (_, Just (DestImm (ImmCLbl lbl))) -> lbl
+    (_, _other) -> panic "shortBlockId"