Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8224ee19793fb4eb5dfa69371ac0a07798aa879e >--------------------------------------------------------------- commit 8224ee19793fb4eb5dfa69371ac0a07798aa879e Author: Simon Marlow <[email protected]> Date: Fri Sep 7 12:50:08 2012 +0100 Fix the PPC and SPARC NCGs to handle multiple info tables in a proc >--------------------------------------------------------------- compiler/nativeGen/PPC/Ppr.hs | 37 +++++++++++++++++++++---------------- compiler/nativeGen/SPARC/Ppr.hs | 37 +++++++++++++++++++++---------------- 2 files changed, 42 insertions(+), 32 deletions(-) diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index 55cc6d2..681b31d 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -31,6 +31,7 @@ import RegClass import TargetReg import OldCmm +import BlockId import CLabel @@ -50,7 +51,7 @@ pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc pprNatCmmDecl (CmmData section dats) = pprSectionHeader section $$ pprDatas dats -pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) = +pprNatCmmDecl proc@(CmmProc top_info lbl (ListGraph blocks)) = case topInfoTable proc of Nothing -> case blocks of @@ -59,19 +60,15 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) = blocks -> -- special case for code without info table: pprSectionHeader Text $$ pprLabel lbl $$ -- blocks guaranteed not null, so label needed - vcat (map pprBasicBlock blocks) + vcat (map (pprBasicBlock top_info) blocks) - Just (Statics info_lbl info) -> + Just (Statics info_lbl _) -> sdocWithPlatform $ \platform -> - pprSectionHeader Text $$ - ( - (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' - else empty) $$ - vcat (map pprData info) $$ - pprLabel info_lbl - ) $$ - vcat (map pprBasicBlock blocks) $$ + (if platformHasSubsectionsViaSymbols platform + then pprSectionHeader Text $$ + ppr (mkDeadStripPreventer info_lbl) <> char ':' + else empty) $$ + vcat (map (pprBasicBlock top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain -- elimination, it might be the target of a goto. (if platformHasSubsectionsViaSymbols platform @@ -89,10 +86,18 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) = else empty) -pprBasicBlock :: NatBasicBlock Instr -> SDoc -pprBasicBlock (BasicBlock blockid instrs) = - pprLabel (mkAsmTempLabel (getUnique blockid)) $$ - vcat (map pprInstr instrs) +pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc +pprBasicBlock info_env (BasicBlock blockid instrs) + = maybe_infotable $$ + pprLabel (mkAsmTempLabel (getUnique blockid)) $$ + vcat (map pprInstr instrs) + where + maybe_infotable = case mapLookup blockid info_env of + Nothing -> empty + Just (Statics info_lbl info) -> + pprSectionHeader Text $$ + vcat (map pprData info) $$ + pprLabel info_lbl diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index e57e5e2..8ae3b4b 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -38,6 +38,7 @@ import PprBase import OldCmm import OldPprCmm() import CLabel +import BlockId import Unique ( Uniquable(..), pprUnique ) import Outputable @@ -52,7 +53,7 @@ pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc pprNatCmmDecl (CmmData section dats) = pprSectionHeader section $$ pprDatas dats -pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) = +pprNatCmmDecl proc@(CmmProc top_info lbl (ListGraph blocks)) = case topInfoTable proc of Nothing -> case blocks of @@ -61,19 +62,15 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) = blocks -> -- special case for code without info table: pprSectionHeader Text $$ pprLabel lbl $$ -- blocks guaranteed not null, so label needed - vcat (map pprBasicBlock blocks) + vcat (map (pprBasicBlock top_info) blocks) - Just (Statics info_lbl info) -> + Just (Statics info_lbl _) -> sdocWithPlatform $ \platform -> - pprSectionHeader Text $$ - ( - (if platformHasSubsectionsViaSymbols platform - then ppr (mkDeadStripPreventer info_lbl) <> char ':' - else empty) $$ - vcat (map pprData info) $$ - pprLabel info_lbl - ) $$ - vcat (map pprBasicBlock blocks) $$ + (if platformHasSubsectionsViaSymbols platform + then pprSectionHeader Text $$ + ppr (mkDeadStripPreventer info_lbl) <> char ':' + else empty) $$ + vcat (map (pprBasicBlock top_info) blocks) $$ -- above: Even the first block gets a label, because with branch-chain -- elimination, it might be the target of a goto. (if platformHasSubsectionsViaSymbols platform @@ -91,10 +88,18 @@ pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) = else empty) -pprBasicBlock :: NatBasicBlock Instr -> SDoc -pprBasicBlock (BasicBlock blockid instrs) = - pprLabel (mkAsmTempLabel (getUnique blockid)) $$ - vcat (map pprInstr instrs) +pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc +pprBasicBlock info_env (BasicBlock blockid instrs) + = maybe_infotable $$ + pprLabel (mkAsmTempLabel (getUnique blockid)) $$ + vcat (map pprInstr instrs) + where + maybe_infotable = case mapLookup blockid info_env of + Nothing -> empty + Just (Statics info_lbl info) -> + pprSectionHeader Text $$ + vcat (map pprData info) $$ + pprLabel info_lbl pprDatas :: CmmStatics -> SDoc _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
