projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add spill/reload pseudo instrs to MachInstrs
[ghc-hetmet.git] / compiler / nativeGen / RegAllocInfo.hs
diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs
index df74218..9b60fb9 100644 (file)
--- a/compiler/nativeGen/RegAllocInfo.hs
+++ b/compiler/nativeGen/RegAllocInfo.hs
@@ -17,6 +17,8 @@ module RegAllocInfo (
        patchJump,
        isRegRegMove,
 
+        JumpDest, canShortcut, shortcutJump, shortcutStatic,
+
        maxSpillSlots,
        mkSpillInstr,
        mkLoadInstr,
@@ -26,7 +28,8 @@ module RegAllocInfo (
 
 #include "HsVersions.h"
 
-import Cmm             ( BlockId )
+import Cmm
+import CLabel
 import MachOp           ( MachRep(..), wordRep )
 import MachInstrs
 import MachRegs
@@ -66,6 +69,8 @@ interesting (RealReg i)       = isFastTrue (freeReg i)
 
 #if alpha_TARGET_ARCH
 regUsage instr = case instr of
+    SPILL  reg slot    -> usage ([reg], [])
+    RELOAD slot reg    -> usage ([], [reg])
     LD B reg addr      -> usage (regAddr addr, [reg, t9])
     LD Bu reg addr     -> usage (regAddr addr, [reg, t9])
 --  LD W reg addr      -> usage (regAddr addr, [reg, t9]) : UNUSED
@@ -156,6 +161,8 @@ regUsage instr = case instr of
     IDIV   sz op       -> mkRU (eax:edx:use_R op) [eax,edx]
     AND    sz src dst  -> usageRM src dst
     OR     sz src dst  -> usageRM src dst
+    XOR    sz (OpReg src) (OpReg dst)
+        | src == dst    -> mkRU [] [dst]
     XOR    sz src dst  -> usageRM src dst
     NOT    sz op       -> usageM op
     NEGI   sz op       -> usageM op
@@ -170,6 +177,7 @@ regUsage instr = case instr of
     CMP    sz src dst  -> mkRUR (use_R src ++ use_R dst)
     SETCC  cond op     -> mkRU [] (def_W op)
     JXX    cond lbl    -> mkRU [] []
+    JXX_GBL cond lbl   -> mkRU [] []
     JMP    op          -> mkRUR (use_R op)
     JMP_TBL op ids      -> mkRUR (use_R op)
     CALL (Left imm)  params -> mkRU params callClobberedRegs
@@ -208,8 +216,8 @@ regUsage instr = case instr of
 #if x86_64_TARGET_ARCH
     CVTSS2SD src dst   -> mkRU [src] [dst]
     CVTSD2SS src dst   -> mkRU [src] [dst]
-    CVTSS2SI src dst   -> mkRU (use_R src) [dst]
-    CVTSD2SI src dst   -> mkRU (use_R src) [dst]
+    CVTTSS2SIQ src dst -> mkRU (use_R src) [dst]
+    CVTTSD2SIQ src dst -> mkRU (use_R src) [dst]
     CVTSI2SS src dst   -> mkRU (use_R src) [dst]
     CVTSI2SD src dst   -> mkRU (use_R src) [dst]
     FDIV sz src dst     -> usageRM src dst
@@ -220,6 +228,8 @@ regUsage instr = case instr of
 
     COMMENT _          -> noUsage
     DELTA   _           -> noUsage
+    SPILL   reg slot   -> mkRU [reg] []
+    RELOAD  slot reg   -> mkRU []    [reg]
 
     _other             -> panic "regUsage: unrecognised instr"
 
@@ -269,6 +279,9 @@ regUsage instr = case instr of
 #if sparc_TARGET_ARCH
 
 regUsage instr = case instr of
+    SPILL reg slot     -> usage ([reg], [])
+    RELOAD slot reg    -> usage ([], [reg])
+
     LD    sz addr reg          -> usage (regAddr addr, [reg])
     ST    sz reg addr          -> usage (reg : regAddr addr, [])
     ADD   x cc r1 ar r2        -> usage (r1 : regRI ar, [r2])
@@ -321,6 +334,9 @@ regUsage instr = case instr of
 #if powerpc_TARGET_ARCH
 
 regUsage instr = case instr of
+    SPILL  reg slot    -> usage ([reg], [])
+    RELOAD slot reg    -> usage ([], [reg])
+
     LD    sz reg addr          -> usage (regAddr addr, [reg])
     LA    sz reg addr          -> usage (regAddr addr, [reg])
     ST    sz reg addr          -> usage (reg : regAddr addr, [])
@@ -331,6 +347,7 @@ regUsage instr = case instr of
     CMP   sz reg ri    -> usage (reg : regRI ri,[])
     CMPL  sz reg ri    -> usage (reg : regRI ri,[])
     BCC          cond lbl      -> noUsage
+    BCCFAR cond lbl    -> noUsage
     MTCTR reg          -> usage ([reg],[])
     BCTR  targets      -> noUsage
     BL    imm params   -> usage (params, callClobberedRegs)
@@ -395,6 +412,7 @@ jumpDests insn acc
        JMP_TBL _ ids   -> ids ++ acc
 #elif powerpc_TARGET_ARCH
         BCC _ id        -> id : acc
+        BCCFAR _ id     -> id : acc
         BCTR targets    -> targets ++ acc
 #endif
        _other          -> acc
@@ -408,10 +426,50 @@ patchJump insn old new
        JMP_TBL op ids -> error "Cannot patch JMP_TBL"
 #elif powerpc_TARGET_ARCH
         BCC cc id | id == old -> BCC cc new
+        BCCFAR cc id | id == old -> BCCFAR cc new
         BCTR targets -> error "Cannot patch BCTR"
 #endif
        _other          -> insn
 
+data JumpDest = DestBlockId BlockId | DestImm Imm
+
+canShortcut :: Instr -> Maybe JumpDest
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+canShortcut (JXX ALWAYS id) = Just (DestBlockId id)
+canShortcut (JMP (OpImm imm)) = Just (DestImm imm)
+#endif
+canShortcut _ = Nothing
+
+shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
+#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
+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)
+#endif
+shortcutJump fn 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 fn other_static
+        = other_static
+
+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"
+
 -- -----------------------------------------------------------------------------
 -- 'patchRegs' function
 
@@ -423,6 +481,8 @@ patchRegs :: Instr -> (Reg -> Reg) -> Instr
 #if alpha_TARGET_ARCH
 
 patchRegs instr env = case instr of
+    SPILL  reg slot    -> SPILL (env reg) slot
+    RELOAD slot reg    -> RELOAD slot (env reg)
     LD sz reg addr -> LD sz (env reg) (fixAddr addr)
     LDA reg addr -> LDA (env reg) (fixAddr addr)
     LDAH reg addr -> LDAH (env reg) (fixAddr addr)
@@ -540,8 +600,8 @@ patchRegs instr env = case instr of
 #if x86_64_TARGET_ARCH
     CVTSS2SD src dst   -> CVTSS2SD (env src) (env dst)
     CVTSD2SS src dst   -> CVTSD2SS (env src) (env dst)
-    CVTSS2SI src dst   -> CVTSS2SI (patchOp src) (env dst)
-    CVTSD2SI src dst   -> CVTSD2SI (patchOp src) (env dst)
+    CVTTSS2SIQ src dst -> CVTTSS2SIQ (patchOp src) (env dst)
+    CVTTSD2SIQ src dst -> CVTTSD2SIQ (patchOp src) (env dst)
     CVTSI2SS src dst   -> CVTSI2SS (patchOp src) (env dst)
     CVTSI2SD src dst   -> CVTSI2SD (patchOp src) (env dst)
     FDIV sz src dst    -> FDIV sz (patchOp src) (patchOp dst)
@@ -556,7 +616,11 @@ patchRegs instr env = case instr of
     NOP                        -> instr
     COMMENT _          -> instr
     DELTA _            -> instr
+    SPILL  reg slot    -> SPILL (env reg) slot
+    RELOAD slot reg    -> RELOAD slot (env reg)
+
     JXX _ _            -> instr
+    JXX_GBL _ _                -> instr
     CLTD _             -> instr
 
     _other             -> panic "patchRegs: unrecognised instr"
@@ -585,6 +649,8 @@ patchRegs instr env = case instr of
 #if sparc_TARGET_ARCH
 
 patchRegs instr env = case instr of
+    SPILL reg slot     -> SPILL (env reg) slot
+    RELOAD slot reg    -> RELOAD slot (env reg)
     LD    sz addr reg   -> LD sz (fixAddr addr) (env reg)
     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
     ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
@@ -628,6 +694,9 @@ patchRegs instr env = case instr of
 #if powerpc_TARGET_ARCH
 
 patchRegs instr env = case instr of
+    SPILL reg slot     -> SPILL (env reg) slot
+    RELOAD slot reg    -> RELOAD slot (env reg)
+
     LD    sz reg addr   -> LD sz (env reg) (fixAddr addr)
     LA    sz reg addr   -> LA sz (env reg) (fixAddr addr)
     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
@@ -638,6 +707,7 @@ patchRegs instr env = case instr of
     CMP          sz reg ri     -> CMP sz (env reg) (fixRI ri)
     CMPL  sz reg ri    -> CMPL sz (env reg) (fixRI ri)
     BCC          cond lbl      -> BCC cond lbl
+    BCCFAR cond lbl    -> BCCFAR cond lbl
     MTCTR reg          -> MTCTR (env reg)
     BCTR  targets      -> BCTR targets
     BL    imm argRegs  -> BL imm argRegs       -- argument regs
@@ -710,8 +780,8 @@ mkSpillInstr
    -> Int              -- spill slot to use
    -> Instr
 mkSpillInstr reg delta slot
-  = ASSERT(isRealReg reg)
-    let        
+ -- = ASSERT(isRealReg reg)                    -- BUGS: used for graph coloring: is this ok?
+  = let        
         off     = spillSlotToOffset slot
     in
 #ifdef alpha_TARGET_ARCH
@@ -755,8 +825,8 @@ mkLoadInstr
    -> Int              -- spill slot to use
    -> Instr
 mkLoadInstr reg delta slot
-  = ASSERT(isRealReg reg)
-    let
+ -- = ASSERT(isRealReg reg)                    -- BUGS: used for graph coloring: is this ok?
+  = let
         off     = spillSlotToOffset slot
     in
 #if alpha_TARGET_ARCH
@@ -841,4 +911,5 @@ spillSlotToOffset slot
    = 64 + spillSlotSize * slot
    | otherwise
    = pprPanic "spillSlotToOffset:" 
-              (text "invalid spill location: " <> int slot)
+              (   text "invalid spill location: " <> int slot
+             $$  text "maxSpillSlots:          " <> int maxSpillSlots)
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)