Commit a8e1e190 authored by dias@eecs.tufts.edu's avatar dias@eecs.tufts.edu
Browse files

Better handling of node parameter in calling conventions

 - Previously, the node was taken as a parameter, then ignored,
   for static closures. Goofy. Now, the vestigial node parameters
   are gone.
parent 01f842b9
......@@ -171,12 +171,11 @@ assign_bits_reg :: SlotAssigner -> Width -> WordOff -> VGcPtr -> AvailRegs -> As
assign_bits_reg _ W128 _ _ _ = panic "W128 is not a supported register type"
assign_bits_reg _ w off gcp (v:vs, fs, ds, ls)
| widthInBits w <= widthInBits wordWidth =
pprTrace "long regs" (ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG) $ (RegisterParam (v gcp), off, 0, (vs, fs, ds, ls))
(RegisterParam (v gcp), off, 0, (vs, fs, ds, ls))
assign_bits_reg _ w off _ (vs, fs, ds, l:ls)
| widthInBits w > widthInBits wordWidth =
pprTrace "long regs" (ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG) $ (RegisterParam l, off, 0, (vs, fs, ds, ls))
assign_bits_reg assign_slot w off _ regs@(_, _, _, ls) =
pprTrace "long regs" (ppr w <+> ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG <+> ppr mAX_Long_REG) $ assign_slot w off regs
(RegisterParam l, off, 0, (vs, fs, ds, ls))
assign_bits_reg assign_slot w off _ regs@(_, _, _, ls) = assign_slot w off regs
assign_float_reg :: SlotAssigner -> Width -> WordOff -> AvailRegs -> Assignment
assign_float_reg _ W32 off (vs, f:fs, ds, ls) = (RegisterParam $ f, off, 0, (vs, fs, ds, ls))
......
......@@ -453,13 +453,20 @@ splitAtProcPoints entry_label callPPs procPoints procMap
graphEnv <- foldM add_jumps emptyBlockEnv $ blockEnvToList graphEnv
let to_proc (bid, g) | elemBlockSet bid callPPs =
if bid == entry then
CmmProc (CmmInfo gc upd_fr info_tbl) top_l top_args g
CmmProc (CmmInfo gc upd_fr info_tbl) top_l top_args (replacePPIds g)
else
CmmProc emptyContInfoTable lbl [] g
CmmProc emptyContInfoTable lbl [] (replacePPIds g)
where lbl = expectJust "pp label" $ lookupFM procLabels bid
to_proc (bid, g) =
CmmProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] g
CmmProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] (replacePPIds g)
where lbl = expectJust "pp label" $ lookupFM procLabels bid
-- References to procpoint IDs can now be replaced with the infotable's label
replacePPIds (x, g) = (x, map_nodes id (mapExpMiddle repl) (mapExpLast repl) g)
where repl e@(CmmLit (CmmBlock bid)) =
case lookupFM procLabels bid of
Just l -> CmmLit (CmmLabel (entryLblToInfoLbl l))
Nothing -> e
repl e = e
-- The C back end expects to see return continuations before the call sites.
-- Here, we sort them in reverse order -- it gets reversed later.
let (_, block_order) = foldl add_block_num (0::Int, emptyBlockEnv) (postorder_dfs g)
......
......@@ -262,8 +262,6 @@ mkCmmCall f results actuals = mkCall f (NativeDirectCall, NativeReturn) results
-- I'm dropping the SRT, but that should be okay: we plan to reconstruct it later.
mkCall f (callConv, retConv) results actuals updfr_off =
pprTrace "mkCall" (ppr f <+> ppr actuals <+> ppr results <+> ppr callConv <+>
ppr retConv) $
withFreshLabel "call successor" $ \k ->
let area = CallArea $ Young k
(off, copyin) = copyInOflow retConv area results
......
......@@ -467,13 +467,15 @@ emitClosureProcAndInfoTable :: Bool -- top-level?
-> FCode ()
emitClosureProcAndInfoTable top_lvl bndr cl_info args body
= do { let lf_info = closureLFInfo cl_info
-- Bind the binder itself, but only if it's not a top-level
-- Bind the binder itself, but only if it's not a top-level
-- binding. We need non-top let-bindings to refer to the
-- top-level binding, which this binding would incorrectly shadow.
; node <- if top_lvl then return $ idToReg (NonVoid bndr)
else bindToReg (NonVoid bndr) lf_info
; let node_points = nodeMustPointToIt lf_info
; arg_regs <- bindArgsToRegs args
; emitClosureAndInfoTable cl_info (node : arg_regs) $ body (node, arg_regs)
; let args' = if node_points then (node : arg_regs) else arg_regs
; emitClosureAndInfoTable cl_info args' $ body (node, arg_regs)
}
-- Data constructors need closures, but not with all the argument handling
......@@ -482,7 +484,9 @@ emitClosureAndInfoTable :: ClosureInfo -> [LocalReg] -> FCode () -> FCode ()
emitClosureAndInfoTable cl_info args body
= do { info <- mkCmmInfo cl_info
; blks <- getCode body
; emitProc info (infoLblToEntryLbl info_lbl) args blks
; let conv = if nodeMustPointToIt (closureLFInfo cl_info) then NativeNodeCall
else NativeDirectCall
; emitProcWithConvention conv info (infoLblToEntryLbl info_lbl) args blks
}
where
info_lbl = infoTableLabelFromCI cl_info
......
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