X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocInfo.hs;h=80702bd61d2ee3ae83da706cb5dae2ef755794a6;hp=9b60fb9d60956a5045f76b0421e803864cff53e4;hb=176fa33f17dd78355cc572e006d2ab26898e2c69;hpb=0168c633a9d209e978528f059193d19cdb5e6740 diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index 9b60fb9..80702bd 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 @@ -592,9 +599,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 @@ -767,7 +774,7 @@ isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2) #elif powerpc_TARGET_ARCH isRegRegMove (MR dst src) = Just (src,dst) #else -#warning ToDo: isRegRegMove +#error ToDo: isRegRegMove #endif isRegRegMove _ = Nothing @@ -775,14 +782,12 @@ 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 +796,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 @@ -809,25 +814,23 @@ mkSpillInstr reg delta slot RcInteger -> I32; RcFloat -> F32; RcDouble -> F64}} - in ST sz reg (fpRel (- off_w)) + 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 +838,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; + RcInteger -> II32; + RcFloat -> FF32; RcDouble -> F64}} 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 +869,16 @@ 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 +#else +#error ToDo: mkRegRegMoveInstr #endif mkBranchInstr