X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FAsmCodeGen.lhs;h=27858dc84722769f69877de053c4d36c38f0666e;hb=103494b47713dc1ee378082ae8ad4352519b7e3f;hp=eeb5f2ebd7672d316dba6595975da3acb03d02f4;hpb=659f147413af7f4f2d2b500659e7c03f31f16d35;p=ghc-hetmet.git diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index eeb5f2e..27858dc 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -58,7 +58,7 @@ import NCGMonad import BlockId import CgUtils ( fixStgRegisters ) import OldCmm -import CmmOpt ( cmmMiniInline, cmmMachOpFold ) +import CmmOpt ( cmmEliminateDeadBlocks, cmmMiniInline, cmmMachOpFold ) import OldPprCmm import CLabel @@ -372,10 +372,25 @@ cmmNativeGen dflags us cmm count , Nothing , mPprStats) - ---- generate jump tables + ---- x86fp_kludge. This pass inserts ffree instructions to clear + ---- the FPU stack on x86. The x86 ABI requires that the FPU stack + ---- is clear, and library functions can return odd results if it + ---- isn't. + ---- + ---- NB. must happen before shortcutBranches, because that + ---- generates JXX_GBLs which we can't fix up in x86fp_kludge. + let kludged = +#if i386_TARGET_ARCH + {-# SCC "x86fp_kludge" #-} + map x86fp_kludge alloced +#else + alloced +#endif + + ---- generate jump tables let tabled = {-# SCC "generateJumpTables" #-} - alloced ++ generateJumpTables alloced + generateJumpTables kludged ---- shortcut branches let shorted = @@ -387,27 +402,18 @@ cmmNativeGen dflags us cmm count {-# SCC "sequenceBlocks" #-} map sequenceTop shorted - ---- x86fp_kludge - let kludged = -#if i386_TARGET_ARCH - {-# SCC "x86fp_kludge" #-} - map x86fp_kludge sequenced -#else - sequenced -#endif - - ---- expansion of SPARC synthetic instrs + ---- expansion of SPARC synthetic instrs #if sparc_TARGET_ARCH let expanded = {-# SCC "sparc_expand" #-} - map expandTop kludged + map expandTop sequenced dumpIfSet_dyn dflags Opt_D_dump_asm_expanded "Synthetic instructions expanded" (vcat $ map (docToSDoc . pprNatCmmTop) expanded) #else let expanded = - kludged + sequenced #endif return ( usAlloc @@ -615,8 +621,8 @@ makeFarBranches = id generateJumpTables :: [NatCmmTop Instr] -> [NatCmmTop Instr] generateJumpTables xs = concatMap f xs - where f (CmmProc _ _ (ListGraph xs)) = concatMap g xs - f _ = [] + where f p@(CmmProc _ _ (ListGraph xs)) = p : concatMap g xs + f p = [p] g (BasicBlock _ xs) = catMaybes (map generateJumpTableForInstr xs) -- ----------------------------------------------------------------------------- @@ -729,10 +735,9 @@ Here we do: and position independent refs (ii) compile a list of imported symbols -Ideas for other things we could do (ToDo): +Ideas for other things we could do: - shortcut jumps-to-jumps - - eliminate dead code blocks - simple CSE: if an expr is assigned to a temp, then replace later occs of that expr with the temp, until the expr is no longer valid (can push through temp assignments, and certain assigns to mem...) @@ -741,7 +746,7 @@ Ideas for other things we could do (ToDo): cmmToCmm :: DynFlags -> RawCmmTop -> (RawCmmTop, [CLabel]) cmmToCmm _ top@(CmmData _ _) = (top, []) cmmToCmm dflags (CmmProc info lbl (ListGraph blocks)) = runCmmOpt dflags $ do - blocks' <- mapM cmmBlockConFold (cmmMiniInline blocks) + blocks' <- mapM cmmBlockConFold (cmmMiniInline (cmmEliminateDeadBlocks blocks)) return $ CmmProc info lbl (ListGraph blocks') newtype CmmOptM a = CmmOptM (([CLabel], DynFlags) -> (# a, [CLabel] #))