diff options
author | dias@eecs.tufts.edu <unknown> | 2009-03-25 16:38:15 +0000 |
---|---|---|
committer | dias@eecs.tufts.edu <unknown> | 2009-03-25 16:38:15 +0000 |
commit | a8e1e190ee5aa16f31bdde26daf3c897314e8994 (patch) | |
tree | dd1124491a7666941a16b53caaa09978e82da98c /compiler/codeGen | |
parent | 01f842b978c903595d4b3184a0761d04a02e5b09 (diff) | |
download | haskell-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.hs | 10 |
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 |