Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5c1fbb46e8e64c81d887762207334731669adcc2 >--------------------------------------------------------------- commit 5c1fbb46e8e64c81d887762207334731669adcc2 Author: Simon Marlow <[email protected]> Date: Fri Dec 9 10:20:13 2011 +0000 some small optimisations >--------------------------------------------------------------- compiler/nativeGen/RegAlloc/Liveness.hs | 2 +- compiler/nativeGen/X86/Instr.hs | 66 +++++++++++++++--------------- 2 files changed, 34 insertions(+), 34 deletions(-) diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index 993156a..0212e8c 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -912,7 +912,7 @@ liveness1 liveregs blockmap (LiveInstr instr _) , liveDieWrite = mkUniqSet w_dying })) where - RU read written = regUsageOfInstr instr + !(RU read written) = regUsageOfInstr instr -- registers that were written here are dead going backwards. -- registers that were read here are live going backwards. diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 8150420..6cd218c 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -330,10 +330,10 @@ x86_regUsageOfInstr instr ADC _ src dst -> usageRM src dst SUB _ src dst -> usageRM src dst IMUL _ src dst -> usageRM src dst - IMUL2 _ src -> mkRU (eax:use_R src) [eax,edx] + IMUL2 _ src -> mkRU (eax:use_R src []) [eax,edx] MUL _ src dst -> usageRM src dst - DIV _ op -> mkRU (eax:edx:use_R op) [eax,edx] - IDIV _ op -> mkRU (eax:edx:use_R op) [eax,edx] + DIV _ op -> mkRU (eax:edx:use_R op []) [eax,edx] + IDIV _ op -> mkRU (eax:edx:use_R op []) [eax,edx] AND _ src dst -> usageRM src dst OR _ src dst -> usageRM src dst @@ -346,25 +346,25 @@ x86_regUsageOfInstr instr SHL _ imm dst -> usageRM imm dst SAR _ imm dst -> usageRM imm dst SHR _ imm dst -> usageRM imm dst - BT _ _ src -> mkRUR (use_R src) + BT _ _ src -> mkRUR (use_R src []) - PUSH _ op -> mkRUR (use_R op) + PUSH _ op -> mkRUR (use_R op []) POP _ op -> mkRU [] (def_W op) - TEST _ src dst -> mkRUR (use_R src ++ use_R dst) - CMP _ src dst -> mkRUR (use_R src ++ use_R dst) + TEST _ src dst -> mkRUR (use_R src $! use_R dst []) + CMP _ src dst -> mkRUR (use_R src $! use_R dst []) SETCC _ op -> mkRU [] (def_W op) JXX _ _ -> mkRU [] [] JXX_GBL _ _ -> mkRU [] [] - JMP op -> mkRUR (use_R op) - JMP_TBL op _ _ _ -> mkRUR (use_R op) + JMP op -> mkRUR (use_R op []) + JMP_TBL op _ _ _ -> mkRUR (use_R op []) CALL (Left _) params -> mkRU params callClobberedRegs CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs CLTD _ -> mkRU [eax] [edx] NOP -> mkRU [] [] GMOV src dst -> mkRU [src] [dst] - GLD _ src dst -> mkRU (use_EA src) [dst] - GST _ src dst -> mkRUR (src : use_EA dst) + GLD _ src dst -> mkRU (use_EA src []) [dst] + GST _ src dst -> mkRUR (src : use_EA dst []) GLDZ dst -> mkRU [] [dst] GLD1 dst -> mkRU [] [dst] @@ -392,10 +392,10 @@ x86_regUsageOfInstr instr CVTSS2SD src dst -> mkRU [src] [dst] CVTSD2SS src dst -> mkRU [src] [dst] - CVTTSS2SIQ _ src dst -> mkRU (use_R src) [dst] - CVTTSD2SIQ _ src dst -> mkRU (use_R src) [dst] - CVTSI2SS _ src dst -> mkRU (use_R src) [dst] - CVTSI2SD _ src dst -> mkRU (use_R src) [dst] + CVTTSS2SIQ _ src dst -> mkRU (use_R src []) [dst] + CVTTSD2SIQ _ src dst -> mkRU (use_R src []) [dst] + CVTSI2SS _ src dst -> mkRU (use_R src []) [dst] + CVTSI2SD _ src dst -> mkRU (use_R src []) [dst] FDIV _ src dst -> usageRM src dst FETCHGOT reg -> mkRU [] [reg] @@ -404,27 +404,27 @@ x86_regUsageOfInstr instr COMMENT _ -> noUsage DELTA _ -> noUsage - POPCNT _ src dst -> mkRU (use_R src) [dst] + POPCNT _ src dst -> mkRU (use_R src []) [dst] _other -> panic "regUsage: unrecognised instr" where -- 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) = mkRUR (use_R op ++ use_EA ea) + usageRW op (OpReg reg) = mkRU (use_R op []) [reg] + usageRW op (OpAddr ea) = mkRUR (use_R op $! use_EA ea []) usageRW _ _ = panic "X86.RegInfo.usageRW: no match" -- 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) = mkRUR (use_R op ++ use_EA ea) + usageRM op (OpReg reg) = mkRU (use_R op [reg]) [reg] + usageRM op (OpAddr ea) = mkRUR (use_R op $! use_EA ea []) usageRM _ _ = panic "X86.RegInfo.usageRM: no match" -- 1 operand form; operand Modified usageM :: Operand -> RegUsage usageM (OpReg reg) = mkRU [reg] [reg] - usageM (OpAddr ea) = mkRUR (use_EA ea) + usageM (OpAddr ea) = mkRUR (use_EA ea []) usageM _ = panic "X86.RegInfo.usageM: no match" -- Registers defd when an operand is written. @@ -433,18 +433,18 @@ x86_regUsageOfInstr instr def_W _ = panic "X86.RegInfo.def_W: no match" -- Registers used when an operand is read. - use_R (OpReg reg) = [reg] - use_R (OpImm _) = [] - use_R (OpAddr ea) = use_EA ea + use_R (OpReg reg) tl = reg : tl + use_R (OpImm _) tl = tl + use_R (OpAddr ea) tl = use_EA ea tl -- Registers used to compute an effective address. - use_EA (ImmAddr _ _) = [] - use_EA (AddrBaseIndex base index _) = - use_base base $! use_index index - where use_base (EABaseReg r) x = r : x - use_base _ x = x - use_index EAIndexNone = [] - use_index (EAIndex i _) = [i] + use_EA (ImmAddr _ _) tl = tl + use_EA (AddrBaseIndex base index _) tl = + use_base base $! use_index index tl + where use_base (EABaseReg r) tl = r : tl + use_base _ tl = tl + use_index EAIndexNone tl = tl + use_index (EAIndex i _) tl = i : tl mkRUR src = src' `seq` RU src' [] where src' = filter interesting src @@ -562,10 +562,10 @@ x86_patchRegsOfInstr instr env where lookupBase EABaseNone = EABaseNone lookupBase EABaseRip = EABaseRip - lookupBase (EABaseReg r) = EABaseReg (env r) + lookupBase (EABaseReg r) = EABaseReg $! env r lookupIndex EAIndexNone = EAIndexNone - lookupIndex (EAIndex r i) = EAIndex (env r) i + lookupIndex (EAIndex r i) = (EAIndex $! env r) i -------------------------------------------------------------------------------- _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
