summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
authordias@eecs.tufts.edu <unknown>2009-03-25 16:38:15 +0000
committerdias@eecs.tufts.edu <unknown>2009-03-25 16:38:15 +0000
commita8e1e190ee5aa16f31bdde26daf3c897314e8994 (patch)
treedd1124491a7666941a16b53caaa09978e82da98c /compiler/codeGen
parent01f842b978c903595d4b3184a0761d04a02e5b09 (diff)
downloadhaskell-a8e1e190ee5aa16f31bdde26daf3c897314e8994.tar.gz
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.
Diffstat (limited to 'compiler/codeGen')
-rw-r--r--compiler/codeGen/StgCmmLayout.hs10
1 files changed, 7 insertions, 3 deletions
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index e306dd1046..8c7c434277 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