Commit 5b83f4b4 authored by nr@eecs.harvard.edu's avatar nr@eecs.harvard.edu

added node to push a closure onto the current call context

parent 4b0d7629
......@@ -85,8 +85,9 @@ ofZgraph g = ListGraph $ swallow blocks
mid (MidAssign l r) = CmmAssign l r
mid (MidStore l r) = CmmStore l r
mid (MidUnsafeCall f ress args) = CmmCall f ress args CmmUnsafe CmmMayReturn
mid m@(CopyOut {}) = pcomment (ppr m)
mid m@(CopyIn {}) = pcomment (ppr m <+> text "(proc point)")
mid m@(MidAddToContext {}) = pcomment (ppr m)
mid m@(CopyOut {}) = pcomment (ppr m)
mid m@(CopyIn {}) = pcomment (ppr m <+> text "(proc point)")
pcomment p = scomment $ showSDoc p
block' id prev'
| id == G.lg_entry g = BasicBlock id $ extend_entry (reverse prev')
......
......@@ -60,6 +60,7 @@ middleLiveness m = middle m
middle (MidAssign lhs expr) = gen expr . kill lhs
middle (MidStore addr rval) = gen addr . gen rval
middle (MidUnsafeCall tgt ress args) = gen tgt . gen args . kill ress
middle (MidAddToContext ra args) = gen ra . gen args
middle (CopyIn _ formals _) = kill formals
middle (CopyOut _ actuals) = gen actuals
......
......@@ -262,6 +262,7 @@ middleAvail (NotSpillOrReload m) = middle m
middle (MidAssign lhs _expr) = akill lhs
middle (MidStore {}) = id
middle (MidUnsafeCall _tgt ress _args) = akill ress
middle (MidAddToContext {}) = id
middle (CopyIn _ formals _) = akill formals
middle (CopyOut {}) = id
......
......@@ -8,7 +8,7 @@
module MkZipCfgCmm
( mkNop, mkAssign, mkStore, mkCall, mkCmmCall, mkUnsafeCall, mkFinalCall
, mkJump, mkCbranch, mkSwitch, mkReturn, mkComment, mkCmmIfThenElse
, mkCmmWhileDo
, mkCmmWhileDo, mkAddToContext
, (<*>), sequence, mkLabel, mkBranch
, emptyAGraph, withFreshLabel, withUnique, outOfLine
, lgraphOfAGraph, graphOfAGraph, labelAGraph
......@@ -55,6 +55,9 @@ mkUnsafeCall :: CmmCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph
mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> CmmAGraph
-- Never returns; like exit() or barf()
---------- Context manipulation ('return via')
mkAddToContext :: CmmExpr -> [CmmExpr] -> CmmAGraph
---------- Control transfer
mkJump :: CmmExpr -> CmmActuals -> CmmAGraph
mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
......@@ -87,6 +90,7 @@ mkCbranch pred ifso ifnot = mkLast $ LastCondBranch pred ifso ifnot
mkSwitch e tbl = mkLast $ LastSwitch e tbl
mkUnsafeCall tgt results actuals = mkMiddle $ MidUnsafeCall tgt results actuals
mkAddToContext ra actuals = mkMiddle $ MidAddToContext ra actuals
cmmArgConv, cmmResConv :: Convention
cmmArgConv = ConventionStandard CmmCallConv Arguments
......
......@@ -55,6 +55,14 @@ data Middle
CmmFormals -- zero or more results
CmmActuals -- zero or more arguments
| MidAddToContext -- push a frame on the stack;
-- I will return to this frame
CmmExpr -- The frame's return address; it must be
-- preceded by an info table that describes the
-- live variables.
[CmmExpr] -- The frame's live variables, to go on the
-- stack with the first one at the young end
| CopyIn -- Move incoming parameters or results from conventional
-- locations to registers. Note [CopyIn invariant]
Convention
......@@ -157,12 +165,13 @@ fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edge
instance UserOfLocalRegs Middle where
foldRegsUsed f z m = middle m
where middle (MidComment {}) = z
middle (MidAssign _lhs expr) = foldRegsUsed f z expr
middle (MidStore addr rval) = foldRegsUsed f (foldRegsUsed f z addr) rval
middle (MidUnsafeCall tgt _ress args) = foldRegsUsed f (foldRegsUsed f z tgt) args
middle (MidAssign _lhs expr) = fold f z expr
middle (MidStore addr rval) = fold f (fold f z addr) rval
middle (MidUnsafeCall tgt _ress args) = fold f (fold f z tgt) args
middle (MidAddToContext ra args) = fold f (fold f z ra) args
middle (CopyIn _ _formals _) = z
middle (CopyOut _ actuals) = foldRegsUsed f z actuals
-- fold = foldRegsUsed
middle (CopyOut _ actuals) = fold f z actuals
fold f z m = foldRegsUsed f z m -- avoid monomorphism restriction
instance UserOfLocalRegs Last where
foldRegsUsed f z m = last m
......@@ -230,16 +239,18 @@ pprMiddle stmt = (case stmt of
ptext SLIT(" = "),
ptext SLIT("call"), space,
doubleQuotes(ppr cconv), space,
target fn, parens ( commafy $ map ppr args ),
ppr_target fn, parens ( commafy $ map ppr args ),
semi ]
where
target t@(CmmLit _) = ppr t
target fn' = parens (ppr fn')
MidUnsafeCall (CmmPrim op) results args ->
pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args)
where
lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
MidAddToContext ra args ->
hcat [ ptext SLIT("return via ")
, ppr_target ra, parens (commafy $ map ppr args), semi ]
) <>
if debugPpr then empty
else text " //" <+>
......@@ -249,7 +260,13 @@ pprMiddle stmt = (case stmt of
MidComment {} -> text "MidComment"
MidAssign {} -> text "MidAssign"
MidStore {} -> text "MidStore"
MidUnsafeCall {} -> text "MidUnsafeCall"
MidUnsafeCall {} -> text "MidUnsafeCall"
MidAddToContext {} -> text "MidAddToContext"
ppr_target :: CmmExpr -> SDoc
ppr_target t@(CmmLit _) = ppr t
ppr_target fn' = parens (ppr fn')
pprHinted :: Outputable a => (a, MachHint) -> SDoc
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment