X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocInfo.hs;h=0328b95d5ef8da24d0ca887f82f66d9a094b5f26;hb=497d3a963f679681db098588bcab00121687c8ed;hp=9b60fb9d60956a5045f76b0421e803864cff53e4;hpb=0168c633a9d209e978528f059193d19cdb5e6740;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index 9b60fb9..0328b95 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,6 +35,7 @@ module RegAllocInfo ( #include "HsVersions.h" +import BlockId import Cmm import CLabel import MachOp ( MachRep(..), wordRep ) @@ -35,7 +43,7 @@ import MachInstrs import MachRegs import Outputable import Constants ( rESERVED_C_STACK_BYTES ) -import FastTypes +import FastBool -- ----------------------------------------------------------------------------- -- RegUsage type @@ -208,9 +216,9 @@ regUsage instr = case instr of 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] + 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 +600,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 +775,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 +783,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 (?)-} @@ -809,7 +815,7 @@ 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 @@ -820,14 +826,12 @@ mkSpillInstr reg delta slot 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))) @@ -874,6 +878,8 @@ mkRegRegMoveInstr src dst #endif #elif powerpc_TARGET_ARCH = MR dst src +#else +#error ToDo: mkRegRegMoveInstr #endif mkBranchInstr