X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FAsmCodeGen.lhs;h=93b385f63c632c54f4264c1f49c37ca4d44f5514;hb=9605d81c7c2fd3de0c07500a7f8a141eed89defc;hp=7f0bd452c383c3bb9421a7f4a5980899d5cd2e58;hpb=b4d045ae655e5eae25b88917cfe75d7dc7689c21;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs index 7f0bd45..93b385f 100644 --- a/ghc/compiler/nativeGen/AsmCodeGen.lhs +++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs @@ -33,13 +33,11 @@ import UniqFM import Unique ( Unique, getUnique ) import UniqSupply import FastTypes -#if darwin_TARGET_OS || (powerpc_TARGET_ARCH && linux_TARGET_OS) import List ( groupBy, sortBy ) import CLabel ( pprCLabel ) -#endif import ErrUtils ( dumpIfSet_dyn ) -import CmdLineOpts ( DynFlags, DynFlag(..), dopt, opt_Static, - opt_EnsureSplittableC, opt_PIC ) +import DynFlags ( DynFlags, DynFlag(..), dopt ) +import StaticFlags ( opt_Static, opt_PIC ) import Digraph import qualified Pretty @@ -113,27 +111,36 @@ The machine-dependent bits break down as follows: nativeCodeGen :: DynFlags -> [Cmm] -> UniqSupply -> IO Pretty.Doc nativeCodeGen dflags cmms us - = let ((ppr_cmms, insn_sdoc, imports), _) = initUs us $ + = let (res, _) = initUs us $ cgCmm (concat (map add_split cmms)) cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [CLabel]) cgCmm tops = lazyMapUs (cmmNativeGen dflags) tops `thenUs` \ results -> - let (cmms,docs,imps) = unzip3 results in + case unzip3 results of { (cmms,docs,imps) -> returnUs (Cmm cmms, my_vcat docs, concat imps) - in do + } + in + case res of { (ppr_cmms, insn_sdoc, imports) -> do dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" (pprCmms [ppr_cmms]) - return (insn_sdoc Pretty.$$ dyld_stubs imports) + return (insn_sdoc Pretty.$$ dyld_stubs imports +#if HAVE_SUBSECTIONS_VIA_SYMBOLS + -- On recent versions of Darwin, the linker supports + -- dead-stripping of code and data on a per-symbol basis. + -- There's a hack to make this work in PprMach.pprNatCmmTop. + Pretty.$$ Pretty.text ".subsections_via_symbols" +#endif + ) + } where add_split (Cmm tops) - | opt_EnsureSplittableC = split_marker : tops - | otherwise = tops + | dopt Opt_SplitObjs dflags = split_marker : tops + | otherwise = tops split_marker = CmmProc [] mkSplitMarkerLabel [] [] -#if darwin_TARGET_OS || (powerpc_TARGET_ARCH && linux_TARGET_OS) -- Generate "symbol stubs" for all external symbols that might -- come from a dynamic library. {- dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $ @@ -155,9 +162,6 @@ nativeCodeGen dflags cmms us where doPpr lbl = (lbl, Pretty.render $ pprCLabel lbl astyle) astyle = mkCodeStyle AsmStyle -#else - dyld_stubs imps = Pretty.empty -#endif #ifndef NCG_DEBUG my_vcat sds = Pretty.vcat sds @@ -342,8 +346,14 @@ fixAssign (CmmAssign (CmmGlobal reg) src) fixAssign (CmmCall target results args vols) = mapAndUnzipUs fixResult results `thenUs` \ (results',stores) -> - returnUs (CmmCall target results' args vols : concat stores) + returnUs (caller_save ++ + CmmCall target results' args vols : + caller_restore ++ + concat stores) where + -- we also save/restore any caller-saves STG registers here + (caller_save, caller_restore) = callerSaveVolatileRegs vols + fixResult g@(CmmGlobal reg,hint) = case get_GlobalReg_reg_or_addr reg of Left realreg -> returnUs (g, []) @@ -378,6 +388,9 @@ Ideas for other things we could do (ToDo): - 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...) -} cmmToCmm :: CmmTop -> (CmmTop, [CLabel]) @@ -543,20 +556,53 @@ cmmMachOpFold op arg@[CmmLit (CmmInt x rep)] -- "from" type, in order to truncate to the correct size. -- The final narrow/widen to the destination type -- is implicit in the CmmLit. - MO_S_Conv from to -> CmmLit (CmmInt (narrowS from x) to) + MO_S_Conv from to + | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to) + | otherwise -> CmmLit (CmmInt (narrowS from x) to) MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to) - _ -> panic "cmmMachOpFold: unknown unary op" + + _ -> panic "cmmMachOpFold: unknown unary op" + -- Eliminate conversion NOPs cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x --- ToDo: eliminate multiple conversions. Be careful though: can't remove --- a narrowing, and can't remove conversions to/from floating point types. +-- Eliminate nested conversions where possible +cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]] + | Just (rep1,rep2,signed1) <- isIntConversion conv_inner, + Just (_, rep3,signed2) <- isIntConversion conv_outer + = case () of + -- widen then narrow to the same size is a nop + _ | rep1 < rep2 && rep1 == rep3 -> x + -- Widen then narrow to different size: collapse to single conversion + -- but remember to use the signedness from the widening, just in case + -- the final conversion is a widen. + | rep1 < rep2 && rep2 > rep3 -> + cmmMachOpFold (intconv signed1 rep1 rep3) [x] + -- Nested widenings: collapse if the signedness is the same + | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 -> + cmmMachOpFold (intconv signed1 rep1 rep3) [x] + -- Nested narrowings: collapse + | rep1 > rep2 && rep2 > rep3 -> + cmmMachOpFold (MO_U_Conv rep1 rep3) [x] + | otherwise -> + CmmMachOp conv_outer args + where + isIntConversion (MO_U_Conv rep1 rep2) + | not (isFloatingRep rep1) && not (isFloatingRep rep2) + = Just (rep1,rep2,False) + isIntConversion (MO_S_Conv rep1 rep2) + | not (isFloatingRep rep1) && not (isFloatingRep rep2) + = Just (rep1,rep2,True) + isIntConversion _ = Nothing --- ToDo: eliminate nested comparisons: --- CmmMachOp MO_Lt [CmmMachOp MO_Eq [x,y], CmmLit (CmmInt 0 _)] --- turns into a simple equality test. + intconv True = MO_S_Conv + intconv False = MO_U_Conv + +-- ToDo: a narrow of a load can be collapsed into a narrow load, right? +-- but what if the architecture only supports word-sized loads, should +-- we do the transformation anyway? cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)] = case mop of @@ -803,6 +849,9 @@ lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest) Nothing -> Nothing Just stmts -> Just (stmt:stmts) +lookForInline u expr (CmmNop : rest) + = lookForInline u expr rest + lookForInline u expr (stmt:stmts) = case lookupUFM (getStmtUses stmt) u of Just 1 -> Just (inlineStmt u expr stmt : stmts)