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 ...@@ -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 _ W128 _ _ _ = panic "W128 is not a supported register type"
assign_bits_reg _ w off gcp (v:vs, fs, ds, ls) assign_bits_reg _ w off gcp (v:vs, fs, ds, ls)
| widthInBits w <= widthInBits wordWidth = | 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) assign_bits_reg _ w off _ (vs, fs, ds, l:ls)
| widthInBits w > widthInBits wordWidth = | widthInBits w > widthInBits wordWidth =
pprTrace "long regs" (ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG) $ (RegisterParam l, off, 0, (vs, fs, ds, ls)) (RegisterParam l, off, 0, (vs, fs, ds, ls))
assign_bits_reg assign_slot w off _ regs@(_, _, _, ls) = assign_bits_reg assign_slot w off _ regs@(_, _, _, ls) = assign_slot w off regs
pprTrace "long regs" (ppr w <+> ppr ls <+> ppr wordWidth <+> ppr mAX_Real_Long_REG <+> ppr mAX_Long_REG) $ assign_slot w off regs
assign_float_reg :: SlotAssigner -> Width -> WordOff -> AvailRegs -> Assignment 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)) 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 ...@@ -453,13 +453,20 @@ splitAtProcPoints entry_label callPPs procPoints procMap
graphEnv <- foldM add_jumps emptyBlockEnv $ blockEnvToList graphEnv graphEnv <- foldM add_jumps emptyBlockEnv $ blockEnvToList graphEnv
let to_proc (bid, g) | elemBlockSet bid callPPs = let to_proc (bid, g) | elemBlockSet bid callPPs =
if bid == entry then 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 else
CmmProc emptyContInfoTable lbl [] g CmmProc emptyContInfoTable lbl [] (replacePPIds g)
where lbl = expectJust "pp label" $ lookupFM procLabels bid where lbl = expectJust "pp label" $ lookupFM procLabels bid
to_proc (bid, g) = 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 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. -- The C back end expects to see return continuations before the call sites.
-- Here, we sort them in reverse order -- it gets reversed later. -- Here, we sort them in reverse order -- it gets reversed later.
let (_, block_order) = foldl add_block_num (0::Int, emptyBlockEnv) (postorder_dfs g) 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 ...@@ -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. -- I'm dropping the SRT, but that should be okay: we plan to reconstruct it later.
mkCall f (callConv, retConv) results actuals updfr_off = mkCall f (callConv, retConv) results actuals updfr_off =
pprTrace "mkCall" (ppr f <+> ppr actuals <+> ppr results <+> ppr callConv <+>
ppr retConv) $
withFreshLabel "call successor" $ \k -> withFreshLabel "call successor" $ \k ->
let area = CallArea $ Young k let area = CallArea $ Young k
(off, copyin) = copyInOflow retConv area results (off, copyin) = copyInOflow retConv area results
......
...@@ -467,13 +467,15 @@ emitClosureProcAndInfoTable :: Bool -- top-level? ...@@ -467,13 +467,15 @@ emitClosureProcAndInfoTable :: Bool -- top-level?
-> FCode () -> FCode ()
emitClosureProcAndInfoTable top_lvl bndr cl_info args body emitClosureProcAndInfoTable top_lvl bndr cl_info args body
= do { let lf_info = closureLFInfo cl_info = 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 -- binding. We need non-top let-bindings to refer to the
-- top-level binding, which this binding would incorrectly shadow. -- top-level binding, which this binding would incorrectly shadow.
; node <- if top_lvl then return $ idToReg (NonVoid bndr) ; node <- if top_lvl then return $ idToReg (NonVoid bndr)
else bindToReg (NonVoid bndr) lf_info else bindToReg (NonVoid bndr) lf_info
; let node_points = nodeMustPointToIt lf_info
; arg_regs <- bindArgsToRegs args ; 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 -- Data constructors need closures, but not with all the argument handling
...@@ -482,7 +484,9 @@ emitClosureAndInfoTable :: ClosureInfo -> [LocalReg] -> FCode () -> FCode () ...@@ -482,7 +484,9 @@ emitClosureAndInfoTable :: ClosureInfo -> [LocalReg] -> FCode () -> FCode ()
emitClosureAndInfoTable cl_info args body emitClosureAndInfoTable cl_info args body
= do { info <- mkCmmInfo cl_info = do { info <- mkCmmInfo cl_info
; blks <- getCode body ; 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 where
info_lbl = infoTableLabelFromCI cl_info info_lbl = infoTableLabelFromCI cl_info
......
Supports Markdown
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