summaryrefslogtreecommitdiff
path: root/compiler/cmm
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/cmm')
-rw-r--r--compiler/cmm/Cmm.hs12
-rw-r--r--compiler/cmm/CmmBuildInfoTables.hs8
-rw-r--r--compiler/cmm/CmmContFlowOpt.hs2
-rw-r--r--compiler/cmm/CmmCvt.hs2
-rw-r--r--compiler/cmm/CmmInfo.hs8
-rw-r--r--compiler/cmm/CmmLayoutStack.hs4
-rw-r--r--compiler/cmm/CmmOpt.hs4
-rw-r--r--compiler/cmm/CmmPipeline.hs6
-rw-r--r--compiler/cmm/CmmProcPoint.hs25
-rw-r--r--compiler/cmm/MkGraph.hs12
-rw-r--r--compiler/cmm/OldCmm.hs6
-rw-r--r--compiler/cmm/OldCmmLint.hs2
-rw-r--r--compiler/cmm/PprC.hs2
-rw-r--r--compiler/cmm/PprCmmDecl.hs4
14 files changed, 56 insertions, 41 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 8409f0dbeb..e1701bd4c5 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -71,6 +71,14 @@ data GenCmmDecl d h g
= CmmProc -- A procedure
h -- Extra header such as the info table
CLabel -- Entry label
+ [GlobalReg] -- Registers live on entry. Note that the set of live
+ -- registers will be correct in generated C-- code, but
+ -- not in hand-written C-- code. However,
+ -- splitAtProcPoints calculates correct liveness
+ -- information for CmmProc's. Right now only the LLVM
+ -- back-end relies on correct liveness information and
+ -- for that back-end we always call splitAtProcPoints, so
+ -- all is good.
g -- Control-flow graph for the procedure's code
| CmmData -- Static data
@@ -100,8 +108,8 @@ data CmmTopInfo = TopInfo { info_tbls :: BlockEnv CmmInfoTable
, stack_info :: CmmStackInfo }
topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
-topInfoTable (CmmProc infos _ g) = mapLookup (g_entry g) (info_tbls infos)
-topInfoTable _ = Nothing
+topInfoTable (CmmProc infos _ _ g) = mapLookup (g_entry g) (info_tbls infos)
+topInfoTable _ = Nothing
data CmmStackInfo
= StackInfo {
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 304f4c2170..af78b40e0f 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -250,7 +250,7 @@ to_SRT dflags top_srt off len bmp
-- any CAF that is reachable from c.
localCAFInfo :: CAFEnv -> CmmDecl -> (CAFSet, Maybe CLabel)
localCAFInfo _ (CmmData _ _) = (Set.empty, Nothing)
-localCAFInfo cafEnv proc@(CmmProc _ top_l (CmmGraph {g_entry=entry})) =
+localCAFInfo cafEnv proc@(CmmProc _ top_l _ (CmmGraph {g_entry=entry})) =
case topInfoTable proc of
Just (CmmInfoTable { cit_rep = rep })
| not (isStaticRep rep) && not (isStackRep rep)
@@ -295,7 +295,7 @@ bundle :: Map CLabel CAFSet
-> (CAFEnv, CmmDecl)
-> (CAFSet, Maybe CLabel)
-> (BlockEnv CAFSet, CmmDecl)
-bundle flatmap (env, decl@(CmmProc infos lbl g)) (closure_cafs, mb_lbl)
+bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl)
= ( mapMapWithKey get_cafs (info_tbls infos), decl )
where
entry = g_entry g
@@ -371,8 +371,8 @@ buildSRTs dflags top_srt caf_map
-}
updInfoSRTs :: BlockEnv C_SRT -> CmmDecl -> CmmDecl
-updInfoSRTs srt_env (CmmProc top_info top_l g) =
- CmmProc (top_info {info_tbls = mapMapWithKey updInfoTbl (info_tbls top_info)}) top_l g
+updInfoSRTs srt_env (CmmProc top_info top_l live g) =
+ CmmProc (top_info {info_tbls = mapMapWithKey updInfoTbl (info_tbls top_info)}) top_l live g
where updInfoTbl l info_tbl
= info_tbl { cit_srt = expectJust "updInfo" $ mapLookup l srt_env }
updInfoSRTs _ t = t
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 4028efddf6..82f7243e73 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -28,7 +28,7 @@ cmmCfgOpts :: Bool -> CmmGraph -> CmmGraph
cmmCfgOpts split g = fst (blockConcat split g)
cmmCfgOptsProc :: Bool -> CmmDecl -> CmmDecl
-cmmCfgOptsProc split (CmmProc info lbl g) = CmmProc info' lbl g'
+cmmCfgOptsProc split (CmmProc info lbl live g) = CmmProc info' lbl live g'
where (g', env) = blockConcat split g
info' = info{ info_tbls = new_info_tbls }
new_info_tbls = mapFromList (map upd_info (mapToList (info_tbls info)))
diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index 4830691a22..39f0b86ec8 100644
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -19,7 +19,7 @@ import Outputable
cmmOfZgraph :: CmmGroup -> Old.CmmGroup
cmmOfZgraph tops = map mapTop tops
- where mapTop (CmmProc h l g) = CmmProc (info_tbls h) l (ofZgraph g)
+ where mapTop (CmmProc h l v g) = CmmProc (info_tbls h) l v (ofZgraph g)
mapTop (CmmData s ds) = CmmData s ds
add_hints :: [a] -> [ForeignHint] -> [Old.CmmHinted a]
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index e952c831ff..699469c116 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -90,7 +90,7 @@ mkInfoTable :: DynFlags -> CmmDecl -> UniqSM [RawCmmDecl]
mkInfoTable _ (CmmData sec dat)
= return [CmmData sec dat]
-mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
+mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
--
-- in the non-tables-next-to-code case, procs can have at most a
-- single info table associated with the entry label of the proc.
@@ -99,7 +99,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
= case topInfoTable proc of -- must be at most one
-- no info table
Nothing ->
- return [CmmProc mapEmpty entry_lbl blocks]
+ return [CmmProc mapEmpty entry_lbl live blocks]
Just info@CmmInfoTable { cit_lbl = info_lbl } -> do
(top_decls, (std_info, extra_bits)) <-
@@ -120,7 +120,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
-- Separately emit info table (with the function entry
-- point as first entry) and the entry code
return (top_decls ++
- [CmmProc mapEmpty entry_lbl blocks,
+ [CmmProc mapEmpty entry_lbl live blocks,
mkDataLits Data info_lbl
(CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
@@ -134,7 +134,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
= do
(top_declss, raw_infos) <- unzip `fmap` mapM do_one_info (mapToList infos)
return (concat top_declss ++
- [CmmProc (mapFromList raw_infos) entry_lbl blocks])
+ [CmmProc (mapFromList raw_infos) entry_lbl live blocks])
where
do_one_info (lbl,itbl) = do
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index c7e6e3ae6e..78bef17a42 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -847,8 +847,8 @@ elimStackStores stackmap stackmaps area_off nodes
setInfoTableStackMap :: DynFlags -> BlockEnv StackMap -> CmmDecl -> CmmDecl
-setInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l g)
- = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l g
+setInfoTableStackMap dflags stackmaps (CmmProc top_info@TopInfo{..} l v g)
+ = CmmProc top_info{ info_tbls = mapMapWithKey fix_info info_tbls } l v g
where
fix_info lbl info_tbl@CmmInfoTable{ cit_rep = StackRep _ } =
info_tbl { cit_rep = StackRep (get_liveness lbl) }
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index dffd417e07..0d44f0ffd5 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -419,10 +419,10 @@ exactLog2 x_
cmmLoopifyForC :: DynFlags -> RawCmmDecl -> RawCmmDecl
-- XXX: revisit if we actually want to do this
-- cmmLoopifyForC p@(CmmProc Nothing _ _) = p -- only if there's an info table, ignore case alts
-cmmLoopifyForC dflags (CmmProc infos entry_lbl
+cmmLoopifyForC dflags (CmmProc infos entry_lbl live
(ListGraph blocks@(BasicBlock top_id _ : _))) =
-- pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
- CmmProc infos entry_lbl (ListGraph blocks')
+ CmmProc infos entry_lbl live (ListGraph blocks')
where blocks' = [ BasicBlock id (map do_stmt stmts)
| BasicBlock id stmts <- blocks ]
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index aa8fa2c1f5..70ff754166 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -61,7 +61,7 @@ cpsTop hsc_env proc =
-- later passes by removing lots of empty blocks, so we do it
-- even when optimisation isn't turned on.
--
- CmmProc h l g <- {-# SCC "cmmCfgOpts(1)" #-}
+ CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
return $ cmmCfgOptsProc splitting_proc_points proc
dump Opt_D_dump_cmmz_cfg "Post control-flow optimsations" g
@@ -121,7 +121,7 @@ cpsTop hsc_env proc =
dumpWith dflags Opt_D_dump_cmmz_procmap "procpoint map" pp_map
gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
splitAtProcPoints dflags l call_pps proc_points pp_map
- (CmmProc h l g)
+ (CmmProc h l v g)
dumps Opt_D_dump_cmmz_split "Post splitting" gs
------------- Populate info tables with stack info -----------------
@@ -140,7 +140,7 @@ cpsTop hsc_env proc =
else do
-- attach info tables to return points
- g <- return $ attachContInfoTables call_pps (CmmProc h l g)
+ g <- return $ attachContInfoTables call_pps (CmmProc h l v g)
------------- Populate info tables with stack info -----------------
g <- {-# SCC "setInfoTableStackMap" #-}
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index ddccf7ba49..02b232d488 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -18,6 +18,7 @@ import Cmm
import PprCmm ()
import CmmUtils
import CmmInfo
+import CmmLive (cmmGlobalLiveness)
import Data.List (sortBy)
import Maybes
import Control.Monad
@@ -210,7 +211,7 @@ splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> BlockE
CmmDecl -> UniqSM [CmmDecl]
splitAtProcPoints dflags entry_label callPPs procPoints procMap
(CmmProc (TopInfo {info_tbls = info_tbls})
- top_l g@(CmmGraph {g_entry=entry})) =
+ top_l _ g@(CmmGraph {g_entry=entry})) =
do -- Build a map from procpoints to the blocks they reach
let addBlock b graphEnv =
case mapLookup bid procMap of
@@ -226,6 +227,11 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
where graph = mapLookup procId graphEnv `orElse` mapEmpty
graph' = mapInsert bid b graph
+ let liveness = cmmGlobalLiveness dflags g
+ let ppLiveness pp = filter isArgReg $
+ regSetToList $
+ expectJust "ppLiveness" $ mapLookup pp liveness
+
graphEnv <- return $ foldGraphBlocks addBlock emptyBlockMap g
-- Build a map from proc point BlockId to pairs of:
@@ -248,8 +254,8 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
let add_jump_block (env, bs) (pp, l) =
do bid <- liftM mkBlockId getUniqueM
let b = blockJoin (CmmEntry bid) emptyBlock jump
- jump = CmmCall (CmmLit (CmmLabel l)) Nothing [{-XXX-}] 0 0 0
- -- XXX: No regs are live at the call
+ live = ppLiveness pp
+ jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0
return (mapInsert pp bid env, b : bs)
add_jumps newGraphEnv (ppId, blockEnv) =
@@ -293,17 +299,19 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
| bid == entry
= CmmProc (TopInfo {info_tbls = info_tbls,
stack_info = stack_info})
- top_l (replacePPIds g)
+ top_l live g'
| otherwise
= case expectJust "pp label" $ mapLookup bid procLabels of
(lbl, Just info_lbl)
-> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
, stack_info=stack_info})
- lbl (replacePPIds g)
+ lbl live g'
(lbl, Nothing)
-> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
- lbl (replacePPIds g)
+ lbl live g'
where
+ g' = replacePPIds g
+ live = ppLiveness (g_entry g')
stack_info = StackInfo { arg_space = 0
, updfr_space = Nothing
, do_layout = True }
@@ -333,7 +341,6 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
procs
splitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]
-
-- Only called from CmmProcPoint.splitAtProcPoints. NB. does a
-- recursive lookup, see comment below.
replaceBranches :: BlockEnv BlockId -> CmmGraph -> CmmGraph
@@ -358,8 +365,8 @@ replaceBranches env cmmg
-- Not splitting proc points: add info tables for continuations
attachContInfoTables :: ProcPointSet -> CmmDecl -> CmmDecl
-attachContInfoTables call_proc_points (CmmProc top_info top_l g)
- = CmmProc top_info{info_tbls = info_tbls'} top_l g
+attachContInfoTables call_proc_points (CmmProc top_info top_l live g)
+ = CmmProc top_info{info_tbls = info_tbls'} top_l live g
where
info_tbls' = mapUnion (info_tbls top_info) $
mapFromList [ (l, mkEmptyContInfoTable (infoTblLbl l))
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index 1e2ddfadd1..1536794a70 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -304,20 +304,20 @@ stackStubExpr w = CmmLit (CmmInt 0 w)
copyInOflow :: DynFlags -> Convention -> Area
-> [CmmFormal]
-> [CmmFormal]
- -> (Int, CmmAGraph)
+ -> (Int, [GlobalReg], CmmAGraph)
copyInOflow dflags conv area formals extra_stk
- = (offset, catAGraphs $ map mkMiddle nodes)
- where (offset, nodes) = copyIn dflags conv area formals extra_stk
+ = (offset, gregs, catAGraphs $ map mkMiddle nodes)
+ where (offset, gregs, nodes) = copyIn dflags conv area formals extra_stk
-- Return the number of bytes used for copying arguments, as well as the
-- instructions to copy the arguments.
copyIn :: DynFlags -> Convention -> Area
-> [CmmFormal]
-> [CmmFormal]
- -> (ByteOff, [CmmNode O O])
+ -> (ByteOff, [GlobalReg], [CmmNode O O])
copyIn dflags conv area formals extra_stk
- = (stk_size, map ci (stk_args ++ args))
+ = (stk_size, [r | (_, RegisterParam r) <- args], map ci (stk_args ++ args))
where
ci (reg, RegisterParam r) =
CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal r))
@@ -386,7 +386,7 @@ copyOutOflow dflags conv transfer area actuals updfr_off extra_stack_stuff
mkCallEntry :: DynFlags -> Convention -> [CmmFormal] -> [CmmFormal]
- -> (Int, CmmAGraph)
+ -> (Int, [GlobalReg], CmmAGraph)
mkCallEntry dflags conv formals extra_stk
= copyInOflow dflags conv Old formals extra_stk
diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs
index 8d5c0398cf..fccdd8137d 100644
--- a/compiler/cmm/OldCmm.hs
+++ b/compiler/cmm/OldCmm.hs
@@ -105,7 +105,7 @@ mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
-- | Returns the info table associated with the CmmDecl's entry point,
-- if any.
topInfoTable :: GenCmmDecl a (BlockEnv i) (ListGraph b) -> Maybe i
-topInfoTable (CmmProc infos _ (ListGraph (b:_)))
+topInfoTable (CmmProc infos _ _ (ListGraph (b:_)))
= mapLookup (blockId b) infos
topInfoTable _
= Nothing
@@ -118,8 +118,8 @@ cmmMapGraph :: (g -> g') -> GenCmmGroup d h g -> GenCmmGroup d h g'
cmmMapGraph f tops = map (cmmTopMapGraph f) tops
cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g'
-cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
-cmmTopMapGraph _ (CmmData s ds) = CmmData s ds
+cmmTopMapGraph f (CmmProc h l v g) = CmmProc h l v (f g)
+cmmTopMapGraph _ (CmmData s ds) = CmmData s ds
-----------------------------------------------------------------------------
-- CmmStmt
diff --git a/compiler/cmm/OldCmmLint.hs b/compiler/cmm/OldCmmLint.hs
index f158369b13..9a4fb42bc5 100644
--- a/compiler/cmm/OldCmmLint.hs
+++ b/compiler/cmm/OldCmmLint.hs
@@ -48,7 +48,7 @@ runCmmLint _ l p =
Right _ -> Nothing
lintCmmDecl :: DynFlags -> (GenCmmDecl h i (ListGraph CmmStmt)) -> CmmLint ()
-lintCmmDecl dflags (CmmProc _ lbl (ListGraph blocks))
+lintCmmDecl dflags (CmmProc _ lbl _ (ListGraph blocks))
= addLintInfo (text "in proc " <> ppr lbl) $
let labels = foldl (\s b -> setInsert (blockId b) s) setEmpty blocks
in mapM_ (lintCmmBlock dflags labels) blocks
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index e07bd6459d..e0ff99cb29 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -81,7 +81,7 @@ pprC tops = vcat $ intersperse blankLine $ map pprTop tops
-- top level procs
--
pprTop :: RawCmmDecl -> SDoc
-pprTop proc@(CmmProc _ clbl (ListGraph blocks)) =
+pprTop proc@(CmmProc _ clbl _ (ListGraph blocks)) =
(case topInfoTable proc of
Nothing -> empty
Just (Statics info_clbl info_dat) -> pprDataExterns info_dat $$
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index 2cb90e9a22..354a3d4563 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -92,9 +92,9 @@ pprCmmGroup tops
pprTop :: (Outputable d, Outputable info, Outputable i)
=> GenCmmDecl d info i -> SDoc
-pprTop (CmmProc info lbl graph)
+pprTop (CmmProc info lbl live graph)
- = vcat [ ppr lbl <> lparen <> rparen
+ = vcat [ ppr lbl <> lparen <> rparen <+> ptext (sLit "// ") <+> ppr live
, nest 8 $ lbrace <+> ppr info $$ rbrace
, nest 4 $ ppr graph
, rbrace ]
View Lorry Controller Status