From a8e1e190ee5aa16f31bdde26daf3c897314e8994 Mon Sep 17 00:00:00 2001 From: "dias@eecs.tufts.edu" Date: Wed, 25 Mar 2009 16:38:15 +0000 Subject: [PATCH] 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. --- compiler/cmm/CmmCallConv.hs | 7 +++---- compiler/cmm/CmmProcPointZ.hs | 13 ++++++++++--- compiler/cmm/MkZipCfgCmm.hs | 2 -- compiler/codeGen/StgCmmLayout.hs | 10 +++++++--- 4 files changed, 20 insertions(+), 12 deletions(-) diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs index 990e178..b9df541 100644 --- a/compiler/cmm/CmmCallConv.hs +++ b/compiler/cmm/CmmCallConv.hs @@ -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)) diff --git a/compiler/cmm/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs index 60d6ce1..12997dd 100644 --- a/compiler/cmm/CmmProcPointZ.hs +++ b/compiler/cmm/CmmProcPointZ.hs @@ -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) diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs index 4eabffb..2894ece 100644 --- a/compiler/cmm/MkZipCfgCmm.hs +++ b/compiler/cmm/MkZipCfgCmm.hs @@ -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 diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index e306dd1..8c7c434 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -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 -- 1.7.10.4