X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocInfo.hs;h=da876c38fab721c346ce7148a39208d2f38c5a9f;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=4cb688aaa9fb58ed1f0e53c1631b293a41e02a90;hpb=0f7d268d00795a58a06ae3c92ebbd14571295b84;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index 4cb688a..da876c3 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 @@ -35,7 +42,7 @@ import MachInstrs import MachRegs import Outputable import Constants ( rESERVED_C_STACK_BYTES ) -import FastTypes +import FastBool -- ----------------------------------------------------------------------------- -- RegUsage type @@ -69,6 +76,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 @@ -206,9 +215,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 @@ -226,6 +235,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" @@ -275,6 +286,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]) @@ -327,6 +341,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, []) @@ -471,6 +488,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) @@ -580,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 @@ -604,6 +623,9 @@ 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 @@ -634,6 +656,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) @@ -677,6 +701,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) @@ -747,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 @@ -755,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 (?)-} @@ -789,7 +814,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 @@ -800,14 +825,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))) @@ -854,6 +877,8 @@ mkRegRegMoveInstr src dst #endif #elif powerpc_TARGET_ARCH = MR dst src +#else +#error ToDo: mkRegRegMoveInstr #endif mkBranchInstr