merge GHC HEAD

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

diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index b21f947..93f4d27 100644 (file)
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -29,18 +29,20 @@ import SPARC.Imm
 import SPARC.AddrMode
 import SPARC.Cond
 import SPARC.Regs
+import SPARC.RegPlate
 import SPARC.Base
+import TargetReg
 import Instruction
 import RegClass
 import Reg
 import Size
 
+import CLabel
 import BlockId
-import Cmm
+import OldCmm
 import FastString
 import FastBool
-
-import GHC.Exts
+import Outputable
 
 
 -- | Register or immediate
@@ -52,11 +54,11 @@ data RI
 --     - a literal zero
 --     - register %g0, which is always zero.
 --
-riZero :: RI -> Bool
-riZero (RIImm (ImmInt 0))          = True
-riZero (RIImm (ImmInteger 0))      = True
-riZero (RIReg (RealReg 0))          = True
-riZero _                           = False
+riZero :: RI -> Bool   
+riZero (RIImm (ImmInt 0))                      = True
+riZero (RIImm (ImmInteger 0))                  = True
+riZero (RIReg (RegReal (RealRegSingle 0)))     = True
+riZero _                                       = False
 
 
 -- | Calculate the effective address which would be used by the
@@ -126,6 +128,11 @@ data Instr
        | ST            Size Reg AddrMode               -- size, src, dst
 
        -- Int Arithmetic.
+       --      x:   add/sub with carry bit. 
+       --              In SPARC V9 addx and friends were renamed addc. 
+       --
+       --      cc:  modify condition codes
+       -- 
        | ADD           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst
        | SUB           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst
 
@@ -188,7 +195,7 @@ data Instr
        -- With a tabled jump we know all the possible destinations.
        -- We also need this info so we can work out what regs are live across the jump.
        -- 
-       | JMP_TBL       AddrMode [BlockId]
+       | JMP_TBL       AddrMode [Maybe BlockId] CLabel
 
        | CALL          (Either Imm Reg) Int Bool       -- target, args, terminal
 
@@ -241,7 +248,7 @@ sparc_regUsageOfInstr instr
     FxTOy   _ _  r1 r2                 -> usage ([r1],                 [r2])
 
     JMP     addr               -> usage (regAddr addr, [])
-    JMP_TBL addr _             -> usage (regAddr addr, [])
+    JMP_TBL addr _ _           -> usage (regAddr addr, [])
 
     CALL  (Left _  )  _ True   -> noUsage
     CALL  (Left _  )  n False  -> usage (argRegs n, callClobberedRegs)
@@ -265,11 +272,9 @@ sparc_regUsageOfInstr instr
 interesting :: Reg -> Bool
 interesting reg
  = case reg of
-       VirtualRegI  _  -> True
-       VirtualRegHi _  -> True
-       VirtualRegF  _  -> True
-       VirtualRegD  _  -> True
-       RealReg i       -> isFastTrue (freeReg i)
+       RegVirtual _                    -> True
+       RegReal (RealRegSingle r1)      -> isFastTrue (freeReg r1)
+       RegReal (RealRegPair r1 _)      -> isFastTrue (freeReg r1)
 
 
 
@@ -311,7 +316,7 @@ sparc_patchRegsOfInstr instr env = case instr of
     FxTOy s1 s2 r1 r2          -> FxTOy s1 s2 (env r1) (env r2)
 
     JMP     addr               -> JMP     (fixAddr addr)
-    JMP_TBL addr ids           -> JMP_TBL (fixAddr addr) ids
+    JMP_TBL addr ids l         -> JMP_TBL (fixAddr addr) ids l
 
     CALL  (Left i) n t         -> CALL (Left i) n t
     CALL  (Right r) n t        -> CALL (Right (env r)) n t
@@ -341,7 +346,7 @@ sparc_jumpDestsOfInstr insn
   = case insn of
        BI   _ _ id     -> [id]
        BF   _ _ id     -> [id]
-       JMP_TBL _ ids   -> ids
+       JMP_TBL _ ids _ -> [id | Just id <- ids]
        _               -> []
 
 
@@ -350,6 +355,7 @@ sparc_patchJumpInstr insn patchF
   = case insn of
        BI cc annul id  -> BI cc annul (patchF id)
        BF cc annul id  -> BF cc annul (patchF id)
+       JMP_TBL n ids l -> JMP_TBL n (map (fmap patchF) ids) l
        _               -> insn
 
 
@@ -365,17 +371,18 @@ sparc_mkSpillInstr
 sparc_mkSpillInstr reg _ slot
  = let off     = spillSlotToOffset slot
         off_w  = 1 + (off `div` 4)
-        sz     = case regClass reg of
+        sz     = case targetClassOfReg reg of
                        RcInteger -> II32
                        RcFloat   -> FF32
                        RcDouble  -> FF64
+                       _         -> panic "sparc_mkSpillInstr"
                
     in ST sz reg (fpRel (negate off_w))
 
 
 -- | Make a spill reload instruction.
 sparc_mkLoadInstr
-       :: Reg          -- ^ register to load
+       :: Reg          -- ^ register to load into
        -> Int          -- ^ current stack delta
        -> Int          -- ^ spill slot to use
        -> Instr
@@ -383,10 +390,11 @@ sparc_mkLoadInstr
 sparc_mkLoadInstr reg _ slot
   = let off     = spillSlotToOffset slot
        off_w   = 1 + (off `div` 4)
-        sz     = case regClass reg of
+        sz     = case targetClassOfReg reg of
                        RcInteger -> II32
                        RcFloat   -> FF32
                        RcDouble  -> FF64
+                       _         -> panic "sparc_mkLoadInstr"
 
         in LD sz (fpRel (- off_w)) reg
 
@@ -427,10 +435,17 @@ sparc_mkRegRegMoveInstr
        -> Instr
 
 sparc_mkRegRegMoveInstr src dst
- = case regClass src of
-       RcInteger -> ADD  False False src (RIReg g0) dst
-       RcDouble  -> FMOV FF64 src dst
-       RcFloat   -> FMOV FF32 src dst
+       | srcClass      <- targetClassOfReg src
+       , dstClass      <- targetClassOfReg dst
+       , srcClass == dstClass
+       = case srcClass of
+               RcInteger -> ADD  False False src (RIReg g0) dst
+               RcDouble  -> FMOV FF64 src dst
+               RcFloat   -> FMOV FF32 src dst
+                _         -> panic "sparc_mkRegRegMoveInstr"
+       
+       | otherwise
+       = panic "SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same"
 
 
 -- | Check whether an instruction represents a reg-reg move.