diff options
Diffstat (limited to 'compiler/nativeGen/AsmCodeGen.lhs')
| -rw-r--r-- | compiler/nativeGen/AsmCodeGen.lhs | 66 |
1 files changed, 32 insertions, 34 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 23aca9293c..7710691457 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -7,6 +7,7 @@ -- ----------------------------------------------------------------------------- \begin{code} +{-# LANGUAGE GADTs #-} module AsmCodeGen ( nativeCodeGen ) where #include "HsVersions.h" @@ -50,9 +51,11 @@ import NCGMonad import BlockId import CgUtils ( fixStgRegisters ) -import OldCmm +import Cmm +import CmmUtils +import Hoopl import CmmOpt ( cmmMachOpFold ) -import OldPprCmm +import PprCmm import CLabel import UniqFM @@ -290,8 +293,8 @@ nativeCodeGen' dflags ncgImpl h us cmms | gopt Opt_SplitObjs dflags = split_marker : tops | otherwise = tops - split_marker = CmmProc mapEmpty mkSplitMarkerLabel [] (ListGraph []) - + split_marker = CmmProc mapEmpty mkSplitMarkerLabel [] + (ofBlockList (panic "split_marker_entry") []) cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr) => DynFlags @@ -878,9 +881,9 @@ Ideas for other things we could do (put these in Hoopl please!): cmmToCmm :: DynFlags -> RawCmmDecl -> (RawCmmDecl, [CLabel]) cmmToCmm _ top@(CmmData _ _) = (top, []) -cmmToCmm dflags (CmmProc info lbl live (ListGraph blocks)) = runCmmOpt dflags $ do - blocks' <- mapM cmmBlockConFold blocks - return $ CmmProc info lbl live (ListGraph blocks') +cmmToCmm dflags (CmmProc info lbl live graph) = runCmmOpt dflags $ do + blocks' <- mapM cmmBlockConFold (toBlockList graph) + return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks') newtype CmmOptM a = CmmOptM (([CLabel], DynFlags) -> (# a, [CLabel] #)) @@ -903,10 +906,13 @@ runCmmOpt :: DynFlags -> CmmOptM a -> (a, [CLabel]) runCmmOpt dflags (CmmOptM f) = case f ([], dflags) of (# result, imports #) -> (result, imports) -cmmBlockConFold :: CmmBasicBlock -> CmmOptM CmmBasicBlock -cmmBlockConFold (BasicBlock id stmts) = do +cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock +cmmBlockConFold block = do + let (entry, middle, last) = blockSplit block + stmts = blockToList middle stmts' <- mapM cmmStmtConFold stmts - return $ BasicBlock id stmts' + last' <- cmmStmtConFold last + return $ blockJoin entry (blockFromList stmts') last' -- This does three optimizations, but they're very quick to check, so we don't -- bother turning them off even when the Hoopl code is active. Since @@ -917,13 +923,13 @@ cmmBlockConFold (BasicBlock id stmts) = do -- We might be tempted to skip this step entirely of not Opt_PIC, but -- there is some PowerPC code for the non-PIC case, which would also -- have to be separated. -cmmStmtConFold :: CmmStmt -> CmmOptM CmmStmt +cmmStmtConFold :: CmmNode e x -> CmmOptM (CmmNode e x) cmmStmtConFold stmt = case stmt of CmmAssign reg src -> do src' <- cmmExprConFold DataReference src return $ case src' of - CmmReg reg' | reg == reg' -> CmmNop + CmmReg reg' | reg == reg' -> CmmComment (fsLit "nop") new_src -> CmmAssign reg new_src CmmStore addr src @@ -931,35 +937,27 @@ cmmStmtConFold stmt src' <- cmmExprConFold DataReference src return $ CmmStore addr' src' - CmmJump addr live + CmmCall { cml_target = addr } -> do addr' <- cmmExprConFold JumpReference addr - return $ CmmJump addr' live + return $ stmt { cml_target = addr' } - CmmCall target regs args returns + CmmUnsafeForeignCall target regs args -> do target' <- case target of - CmmCallee e conv -> do + ForeignTarget e conv -> do e' <- cmmExprConFold CallReference e - return $ CmmCallee e' conv - op@(CmmPrim _ Nothing) -> - return op - CmmPrim op (Just stmts) -> - do stmts' <- mapM cmmStmtConFold stmts - return $ CmmPrim op (Just stmts') - args' <- mapM (\(CmmHinted arg hint) -> do - arg' <- cmmExprConFold DataReference arg - return (CmmHinted arg' hint)) args - return $ CmmCall target' regs args' returns - - CmmCondBranch test dest + return $ ForeignTarget e' conv + PrimTarget _ -> + return target + args' <- mapM (cmmExprConFold DataReference) args + return $ CmmUnsafeForeignCall target' regs args' + + CmmCondBranch test true false -> do test' <- cmmExprConFold DataReference test dflags <- getDynFlags return $ case test' of - CmmLit (CmmInt 0 _) -> - CmmComment (mkFastString ("deleted: " ++ - showSDoc dflags (pprStmt stmt))) - - CmmLit (CmmInt _ _) -> CmmBranch dest - _other -> CmmCondBranch test' dest + CmmLit (CmmInt 0 _) -> CmmBranch false + CmmLit (CmmInt _ _) -> CmmBranch true + _other -> CmmCondBranch test' true false CmmSwitch expr ids -> do expr' <- cmmExprConFold DataReference expr |