X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocInfo.hs;h=deb5f34e2108809872171b8c97575c7eff5a2773;hb=6822f86c440bece1fc053336a75dac264325d077;hp=9b60fb9d60956a5045f76b0421e803864cff53e4;hpb=0168c633a9d209e978528f059193d19cdb5e6740;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index 9b60fb9..deb5f34 100644 --- a/compiler/nativeGen/RegAllocInfo.hs +++ b/compiler/nativeGen/RegAllocInfo.hs @@ -1,3 +1,10 @@ +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- Machine-specific parts of the register allocator @@ -28,14 +35,14 @@ module RegAllocInfo ( #include "HsVersions.h" +import BlockId import Cmm import CLabel -import MachOp ( MachRep(..), wordRep ) import MachInstrs import MachRegs import Outputable import Constants ( rESERVED_C_STACK_BYTES ) -import FastTypes +import FastBool -- ----------------------------------------------------------------------------- -- RegUsage type @@ -204,13 +211,13 @@ regUsage instr = case instr of GMUL sz s1 s2 dst -> mkRU [s1,s2] [dst] GDIV sz s1 s2 dst -> mkRU [s1,s2] [dst] - GCMP sz src1 src2 -> mkRUR [src1,src2] - GABS sz src dst -> mkRU [src] [dst] - GNEG sz src dst -> mkRU [src] [dst] - GSQRT sz src dst -> mkRU [src] [dst] - GSIN sz src dst -> mkRU [src] [dst] - GCOS sz src dst -> mkRU [src] [dst] - GTAN sz src dst -> mkRU [src] [dst] + GCMP sz src1 src2 -> mkRUR [src1,src2] + GABS sz src dst -> mkRU [src] [dst] + GNEG sz src dst -> mkRU [src] [dst] + GSQRT sz src dst -> mkRU [src] [dst] + GSIN sz _ _ src dst -> mkRU [src] [dst] + GCOS sz _ _ src dst -> mkRU [src] [dst] + GTAN sz _ _ src dst -> mkRU [src] [dst] #endif #if x86_64_TARGET_ARCH @@ -288,7 +295,10 @@ regUsage instr = case instr of SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) UMUL cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) SMUL cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + UDIV cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SDIV cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) RDY rd -> usage ([], [rd]) + WRY r1 r2 -> usage ([r1, r2], []) AND b r1 ar r2 -> usage (r1 : regRI ar, [r2]) ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2]) OR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) @@ -414,6 +424,11 @@ jumpDests insn acc BCC _ id -> id : acc BCCFAR _ id -> id : acc BCTR targets -> targets ++ acc +#elif sparc_TARGET_ARCH + BI _ _ id -> id : acc + BF _ _ id -> id : acc +#else +#error "RegAllocInfo.jumpDests not finished" #endif _other -> acc @@ -592,9 +607,9 @@ patchRegs instr env = case instr of GABS sz src dst -> GABS sz (env src) (env dst) GNEG sz src dst -> GNEG sz (env src) (env dst) GSQRT sz src dst -> GSQRT sz (env src) (env dst) - GSIN sz src dst -> GSIN sz (env src) (env dst) - GCOS sz src dst -> GCOS sz (env src) (env dst) - GTAN sz src dst -> GTAN sz (env src) (env dst) + GSIN sz l1 l2 src dst -> GSIN sz l1 l2 (env src) (env dst) + GCOS sz l1 l2 src dst -> GCOS sz l1 l2 (env src) (env dst) + GTAN sz l1 l2 src dst -> GTAN sz l1 l2 (env src) (env dst) #endif #if x86_64_TARGET_ARCH @@ -657,7 +672,10 @@ patchRegs instr env = case instr of SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2) UMUL cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2) SMUL cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2) + UDIV cc r1 ar r2 -> UDIV cc (env r1) (fixRI ar) (env r2) + SDIV cc r1 ar r2 -> SDIV cc (env r1) (fixRI ar) (env r2) RDY rd -> RDY (env rd) + WRY r1 r2 -> WRY (env r1) (env r2) AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2) ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2) OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2) @@ -761,28 +779,36 @@ patchRegs instr env = case instr of -- by assigning the src and dest temporaries to the same real register. isRegRegMove :: Instr -> Maybe (Reg,Reg) + #if i386_TARGET_ARCH || x86_64_TARGET_ARCH -- TMP: isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2) + #elif powerpc_TARGET_ARCH isRegRegMove (MR dst src) = Just (src,dst) -#else -#warning ToDo: isRegRegMove + +#elif sparc_TARGET_ARCH +isRegRegMove instr + = case instr of + ADD False False src (RIReg src2) dst + | g0 == src2 -> Just (src, dst) + + FMOV FF64 src dst -> Just (src, dst) + FMOV FF32 src dst -> Just (src, dst) + _ -> Nothing #endif -isRegRegMove _ = Nothing +isRegRegMove _ = Nothing -- ----------------------------------------------------------------------------- -- Generating spill instructions mkSpillInstr - :: Reg -- register to spill (should be a real) + :: Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use -> Instr mkSpillInstr reg delta slot - -- = ASSERT(isRealReg reg) -- BUGS: used for graph coloring: is this ok? - = let - off = spillSlotToOffset slot + = let off = spillSlotToOffset slot in #ifdef alpha_TARGET_ARCH {-Alpha: spill below the stack pointer (?)-} @@ -791,14 +817,14 @@ mkSpillInstr reg delta slot #ifdef i386_TARGET_ARCH let off_w = (off-delta) `div` 4 in case regClass reg of - RcInteger -> MOV I32 (OpReg reg) (OpAddr (spRel off_w)) - _ -> GST F80 reg (spRel off_w) {- RcFloat/RcDouble -} + RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w)) + _ -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -} #endif #ifdef x86_64_TARGET_ARCH let off_w = (off-delta) `div` 8 in case regClass reg of - RcInteger -> MOV I64 (OpReg reg) (OpAddr (spRel off_w)) - RcDouble -> MOV F64 (OpReg reg) (OpAddr (spRel off_w)) + RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w)) + RcDouble -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w)) -- ToDo: will it work to always spill as a double? -- does that cause a stall if the data was a float? #endif @@ -806,28 +832,26 @@ mkSpillInstr reg delta slot {-SPARC: spill below frame pointer leaving 2 words/spill-} let{off_w = 1 + (off `div` 4); sz = case regClass reg of { - RcInteger -> I32; - RcFloat -> F32; - RcDouble -> F64}} - in ST sz reg (fpRel (- off_w)) + RcInteger -> II32; + RcFloat -> FF32; + RcDouble -> FF64;}} + in ST sz reg (fpRel (negate off_w)) #endif #ifdef powerpc_TARGET_ARCH let sz = case regClass reg of - RcInteger -> I32 - RcDouble -> F64 + RcInteger -> II32 + RcDouble -> FF64 in ST sz reg (AddrRegImm sp (ImmInt (off-delta))) #endif mkLoadInstr - :: Reg -- register to load (should be a real) + :: Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use -> Instr mkLoadInstr reg delta slot - -- = ASSERT(isRealReg reg) -- BUGS: used for graph coloring: is this ok? - = let - off = spillSlotToOffset slot + = let off = spillSlotToOffset slot in #if alpha_TARGET_ARCH LD sz dyn (spRel (- (off `div` 8))) @@ -835,27 +859,27 @@ mkLoadInstr reg delta slot #if i386_TARGET_ARCH let off_w = (off-delta) `div` 4 in case regClass reg of { - RcInteger -> MOV I32 (OpAddr (spRel off_w)) (OpReg reg); - _ -> GLD F80 (spRel off_w) reg} {- RcFloat/RcDouble -} + RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg); + _ -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -} #endif #if x86_64_TARGET_ARCH let off_w = (off-delta) `div` 8 in case regClass reg of - RcInteger -> MOV I64 (OpAddr (spRel off_w)) (OpReg reg) - _ -> MOV F64 (OpAddr (spRel off_w)) (OpReg reg) + RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg) + _ -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg) #endif #if sparc_TARGET_ARCH let{off_w = 1 + (off `div` 4); sz = case regClass reg of { - RcInteger -> I32; - RcFloat -> F32; - RcDouble -> F64}} + RcInteger -> II32; + RcFloat -> FF32; + RcDouble -> FF64}} in LD sz (fpRel (- off_w)) reg #endif #if powerpc_TARGET_ARCH let sz = case regClass reg of - RcInteger -> I32 - RcDouble -> F64 + RcInteger -> II32 + RcDouble -> FF64 in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) #endif @@ -866,14 +890,21 @@ mkRegRegMoveInstr mkRegRegMoveInstr src dst #if i386_TARGET_ARCH || x86_64_TARGET_ARCH = case regClass src of - RcInteger -> MOV wordRep (OpReg src) (OpReg dst) + RcInteger -> MOV wordSize (OpReg src) (OpReg dst) #if i386_TARGET_ARCH RcDouble -> GMOV src dst #else - RcDouble -> MOV F64 (OpReg src) (OpReg dst) + RcDouble -> MOV FF64 (OpReg src) (OpReg dst) #endif #elif powerpc_TARGET_ARCH = MR dst src +#elif sparc_TARGET_ARCH + = case regClass src of + RcInteger -> ADD False False src (RIReg g0) dst + RcDouble -> FMOV FF64 src dst + RcFloat -> FMOV FF32 src dst +#else +#error ToDo: mkRegRegMoveInstr #endif mkBranchInstr @@ -888,7 +919,7 @@ mkBranchInstr id = [JXX ALWAYS id] #endif #if sparc_TARGET_ARCH -mkBranchInstr (BlockId id) = [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP] +mkBranchInstr id = [BI ALWAYS False id, NOP] #endif #if powerpc_TARGET_ARCH