X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FInstr.hs;h=5d731bd88dc369c0bfb0896edfd8e8136649199f;hp=b4b6fb5f4be684a9a93f2b360a52e65dca8028a1;hb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;hpb=b04a210e26ca57242fd052f2aa91011a80b76299

diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index b4b6fb5..5d731bd 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -18,14 +18,16 @@ import Instruction
 import Size
 import RegClass
 import Reg
+import TargetReg
 
 import BlockId
 import Cmm
 import FastString
 import FastBool
+import Outputable
+import Constants	(rESERVED_C_STACK_BYTES)
 
 import CLabel
-import Panic
 
 -- Size of a PPC memory address, in bytes.
 --
@@ -441,12 +443,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"
 
 
 
@@ -606,7 +605,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 -}
 
@@ -615,7 +614,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"
@@ -639,7 +638,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
@@ -647,7 +646,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
@@ -655,6 +654,23 @@ x86_mkLoadInstr _ _ _
  	= panic "X86.RegInfo.mkLoadInstr: not defined for this architecture."
 #endif
 
+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)
 
 --------------------------------------------------------------------------------
 
@@ -694,7 +710,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
@@ -777,3 +793,51 @@ 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
+
+
+-- The helper ensures that we don't follow 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 (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"