From 6edcd9381c8e482df8c0b0df10743dcd231f264c Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 26 Jul 2005 13:14:14 +0000 Subject: [PATCH] [project @ 2005-07-26 13:13:20 by simonmar] some small optimisations --- ghc/compiler/nativeGen/RegAllocInfo.hs | 30 +++++++++++++++++------------- ghc/compiler/nativeGen/RegisterAlloc.hs | 22 ++++++++++++---------- 2 files changed, 29 insertions(+), 23 deletions(-) diff --git a/ghc/compiler/nativeGen/RegAllocInfo.hs b/ghc/compiler/nativeGen/RegAllocInfo.hs index 1a5de43..2380370 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.hs +++ b/ghc/compiler/nativeGen/RegAllocInfo.hs @@ -161,16 +161,16 @@ regUsage instr = case instr of SHL sz imm dst -> usageRM imm dst SAR sz imm dst -> usageRM imm dst SHR sz imm dst -> usageRM imm dst - BT sz imm src -> mkRU (use_R src) [] + BT sz imm src -> mkRUR (use_R src) - PUSH sz op -> mkRU (use_R op) [] + PUSH sz op -> mkRUR (use_R op) POP sz op -> mkRU [] (def_W op) - TEST sz src dst -> mkRU (use_R src ++ use_R dst) [] - CMP sz src dst -> mkRU (use_R src ++ use_R dst) [] + TEST sz src dst -> mkRUR (use_R src ++ use_R dst) + CMP sz src dst -> mkRUR (use_R src ++ use_R dst) SETCC cond op -> mkRU [] (def_W op) JXX cond lbl -> mkRU [] [] - JMP op -> mkRU (use_R op) [] - JMP_TBL op ids -> mkRU (use_R op) [] + JMP op -> mkRUR (use_R op) + JMP_TBL op ids -> mkRUR (use_R op) CALL (Left imm) params -> mkRU params callClobberedRegs CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs CLTD sz -> mkRU [eax] [edx] @@ -179,7 +179,7 @@ regUsage instr = case instr of #if i386_TARGET_ARCH GMOV src dst -> mkRU [src] [dst] GLD sz src dst -> mkRU (use_EA src) [dst] - GST sz src dst -> mkRU (src : use_EA dst) [] + GST sz src dst -> mkRUR (src : use_EA dst) GLDZ dst -> mkRU [] [dst] GLD1 dst -> mkRU [] [dst] @@ -195,7 +195,7 @@ 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 -> mkRU [src1,src2] [] + 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] @@ -232,17 +232,17 @@ regUsage instr = case instr of -- 2 operand form; first operand Read; second Written usageRW :: Operand -> Operand -> RegUsage usageRW op (OpReg reg) = mkRU (use_R op) [reg] - usageRW op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) [] + usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) -- 2 operand form; first operand Read; second Modified usageRM :: Operand -> Operand -> RegUsage usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg] - usageRM op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) [] + usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) -- 1 operand form; operand Modified usageM :: Operand -> RegUsage usageM (OpReg reg) = mkRU [reg] [reg] - usageM (OpAddr ea) = mkRU (use_EA ea) [] + usageM (OpAddr ea) = mkRUR (use_EA ea) -- Registers defd when an operand is written. def_W (OpReg reg) = [reg] @@ -262,8 +262,12 @@ regUsage instr = case instr of use_index EAIndexNone = [] use_index (EAIndex i _) = [i] - mkRU src dst = RU (filter interesting src) - (filter interesting dst) + mkRUR src = src' `seq` RU src' [] + where src' = filter interesting src + + mkRU src dst = src' `seq` dst' `seq` RU src' dst' + where src' = filter interesting src + dst' = filter interesting dst #endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/ghc/compiler/nativeGen/RegisterAlloc.hs b/ghc/compiler/nativeGen/RegisterAlloc.hs index 1295f9c..46bfbd2 100644 --- a/ghc/compiler/nativeGen/RegisterAlloc.hs +++ b/ghc/compiler/nativeGen/RegisterAlloc.hs @@ -208,8 +208,9 @@ getFreeRegs cls f = go f 0 -- ToDo: there's no point looking through all the integer registers -- in order to find a floating-point one. -allocateReg :: FreeRegs -> RegNo -> FreeRegs -allocateReg f r = f .&. complement (1 `shiftL` fromIntegral r) +allocateReg :: RegNo -> FreeRegs -> FreeRegs +allocateReg r f = f .&. complement (1 `shiftL` fromIntegral r) + #endif -- ----------------------------------------------------------------------------- @@ -425,12 +426,11 @@ raInsn block_live new_instrs (instr, r_dying, w_dying) = do other -> genRaInsn block_live new_instrs instr r_dying w_dying -genRaInsn block_live new_instrs instr r_dying w_dying = do +genRaInsn block_live new_instrs instr r_dying w_dying = + case regUsage instr of { RU read written -> + case partition isRealReg written of { (real_written1,virt_written) -> + do let - RU read written = regUsage instr - - (real_written1,virt_written) = partition isRealReg written - real_written = [ r | RealReg r <- real_written1 ] -- we don't need to do anything with real registers that are @@ -494,6 +494,7 @@ genRaInsn block_live new_instrs instr r_dying w_dying = do return (patched_instr : w_spills ++ reverse r_spills ++ clobber_saves ++ new_instrs, fixup_blocks) + }} -- ----------------------------------------------------------------------------- -- releaseRegs @@ -503,6 +504,7 @@ releaseRegs regs = do free <- getFreeRegsR loop assig free regs where + loop assig free _ | free `seq` False = undefined loop assig free [] = do setAssigR assig; setFreeRegsR free; return () loop assig free (RealReg r : rs) = loop assig (releaseReg r free) rs loop assig free (r:rs) = @@ -556,7 +558,7 @@ clobberRegs :: [RegNo] -> RegM () clobberRegs [] = return () -- common case clobberRegs clobbered = do freeregs <- getFreeRegsR - setFreeRegsR (foldl allocateReg freeregs clobbered) + setFreeRegsR $! foldr allocateReg freeregs clobbered assig <- getAssigR setAssigR $! clobber assig (ufmToList assig) where @@ -622,7 +624,7 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) = do | Just (InMem slot) <- loc, reading = InBoth my_reg slot | otherwise = InReg my_reg setAssigR (addToUFM assig r $! new_loc) - setFreeRegsR (allocateReg freeregs my_reg) + setFreeRegsR (allocateReg my_reg freeregs) allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs -- case (3): we need to push something out to free up a register @@ -752,7 +754,7 @@ data RA_State ra_blockassig :: BlockAssignment, -- The current mapping from basic blocks to -- the register assignments at the beginning of that block. - ra_freeregs :: FreeRegs, -- free machine registers + ra_freeregs :: {-#UNPACK#-}!FreeRegs, -- free machine registers ra_assig :: RegMap Loc, -- assignment of temps to locations ra_delta :: Int, -- current stack delta ra_stack :: FreeStack -- free stack slots for spilling -- 1.7.10.4