X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmOpt.hs;h=53281b031266c6df33604a71b6fefd455ff5ee1a;hb=889c084e943779e76d19f2ef5e970ff655f511eb;hp=1125ac14a9ea56ec58cd490b7baef10d9850e95c;hpb=591e1dc91ab7bb1f91b516d1b1ea59c3a8809955;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index 1125ac1..53281b0 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -21,8 +21,7 @@ module CmmOpt ( #include "HsVersions.h" -import Cmm -import CmmExpr +import OldCmm import CmmUtils import CLabel import StaticFlags @@ -153,7 +152,7 @@ inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e) inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2) inlineStmt u a (CmmCall target regs es srt ret) = CmmCall (infn target) regs es' srt ret - where infn (CmmCallee fn cconv) = CmmCallee fn cconv + where infn (CmmCallee fn cconv) = CmmCallee (inlineExpr u a fn) cconv infn (CmmPrim p) = CmmPrim p es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ] inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d @@ -441,7 +440,7 @@ cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))] CmmReg _ <- x -> -- We duplicate x below, hence require -- it is a reg. FIXME: remove this restriction. -- shift right is not the same as quot, because it rounds - -- to minus infinity, whereasq uot rounds toward zero. + -- to minus infinity, whereasq quot rounds toward zero. -- To fix this up, we add one less than the divisor to the -- dividend if it is a negative number. -- @@ -532,12 +531,12 @@ exactLog2 x_ -} cmmLoopifyForC :: RawCmmTop -> RawCmmTop -cmmLoopifyForC p@(CmmProc info entry_lbl [] +cmmLoopifyForC p@(CmmProc info entry_lbl (ListGraph blocks@(BasicBlock top_id _ : _))) | null info = p -- only if there's an info table, ignore case alts | otherwise = -- pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $ - CmmProc info entry_lbl [] (ListGraph blocks') + CmmProc info entry_lbl (ListGraph blocks') where blocks' = [ BasicBlock id (map do_stmt stmts) | BasicBlock id stmts <- blocks ]