diff options
Diffstat (limited to 'ghc/compiler/codeGen')
| -rw-r--r-- | ghc/compiler/codeGen/CgClosure.lhs | 13 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgTailCall.lhs | 29 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/ClosureInfo.lhs | 8 |
3 files changed, 40 insertions, 10 deletions
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index dc326087c9..38c88dd999 100644 --- a/ghc/compiler/codeGen/CgClosure.lhs +++ b/ghc/compiler/codeGen/CgClosure.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgClosure.lhs,v 1.36 1999/11/01 17:10:07 simonpj Exp $ +% $Id: CgClosure.lhs,v 1.37 1999/11/02 15:05:43 simonmar Exp $ % \section[CgClosure]{Code generation for closures} @@ -269,6 +269,7 @@ closureCodeBody binder_info closure_info cc [] body cl_descr mod_name = closureDescription mod_name (closureName closure_info) body_label = entryLabelFromCI closure_info + is_box = case body of { StgApp fun [] -> True; _ -> False } body_code = profCtrC SLIT("TICK_ENT_THK") [] `thenC` @@ -577,7 +578,7 @@ thunkWrapper closure_info lbl thunk_code thunkChecks lbl node_points ( -- Overwrite with black hole if necessary - blackHoleIt closure_info node_points `thenC` + blackHoleIt closure_info node_points `thenC` setupUpdate closure_info ( -- setupUpdate *encloses* the rest @@ -624,10 +625,14 @@ blackHoleIt :: ClosureInfo -> Bool -> Code -- Only called for closures with no a blackHoleIt closure_info node_points = if blackHoleOnEntry closure_info && node_points then + let + info_label = infoTableLabelFromCI closure_info + args = [ CLbl info_label DataPtrRep ] + in absC (if closureSingleEntry(closure_info) then - CMacroStmt UPD_BH_SINGLE_ENTRY [CReg node] + CMacroStmt UPD_BH_SINGLE_ENTRY args else - CMacroStmt UPD_BH_UPDATABLE [CReg node]) + CMacroStmt UPD_BH_UPDATABLE args) else nopC \end{code} diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs index c33c649d92..46e3b0219f 100644 --- a/ghc/compiler/codeGen/CgTailCall.lhs +++ b/ghc/compiler/codeGen/CgTailCall.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgTailCall.lhs,v 1.22 1999/06/22 08:00:00 simonpj Exp $ +% $Id: CgTailCall.lhs,v 1.23 1999/11/02 15:05:43 simonmar Exp $ % %******************************************************** %* * @@ -39,7 +39,8 @@ import CgRetConv ( dataReturnConvPrim, import CgStackery ( mkTaggedStkAmodes, adjustStackHW ) import CgUsages ( getSpRelOffset, adjustSpAndHp ) import CgUpdate ( pushSeqFrame ) -import CLabel ( mkUpdInfoLabel, mkRtsPrimOpLabel ) +import CLabel ( mkUpdInfoLabel, mkRtsPrimOpLabel, + mkBlackHoleInfoTableLabel ) import ClosureInfo ( nodeMustPointToIt, getEntryConvention, EntryConvention(..), LambdaFormInfo @@ -55,6 +56,7 @@ import Type ( isUnLiftedType ) import TyCon ( TyCon ) import PrimOp ( PrimOp ) import Util ( zipWithEqual ) +import Unique ( mkPseudoUnique1 ) import Outputable import Panic ( panic, assertPanic ) \end{code} @@ -425,6 +427,23 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts (fast_stk_amodes, tagged_stk_amodes) = splitAt arity stk_arg_amodes + + -- eager blackholing, at the end of the basic block. + node_save = CTemp (mkPseudoUnique1 2) DataPtrRep + (r1_tmp_asst, bh_asst) + = case sequel of +#if 0 + -- no: UpdateCode doesn't tell us that we're in a thunk's entry code. + -- we might be in a case continuation later down the line. Also, + -- we might have pushed a return address on the stack, if we're in + -- a case scrut, and still be in the thunk's entry code. + UpdateCode -> + (CAssign node_save nodeReg, + CAssign (CVal (CIndex node_save (mkIntCLit 0) PtrRep) + PtrRep) + (CLbl mkBlackHoleInfoTableLabel DataPtrRep)) +#endif + _ -> (AbsCNop, AbsCNop) in -- We can omit tags on the arguments passed to the fast entry point, -- but we have to be careful to fill in the tags on any *extra* @@ -442,12 +461,14 @@ doTailCall arg_amodes arg_regs finish_code arity pending_assts -- The stack space for the pushed return addess, -- with any args pushed on top, is recorded in final_sp. - -- Do the simultaneous assignments, - doSimAssts (mkAbstractCs [pending_assts, + -- Do the simultaneous assignments, + doSimAssts (mkAbstractCs [r1_tmp_asst, + pending_assts, reg_arg_assts, fast_arg_assts, tagged_arg_assts, tag_assts]) `thenC` + absC bh_asst `thenC` -- push a return address if necessary -- (after the assignments above, in case we clobber a live diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index 3b7b5a1b1b..157a6b70e2 100644 --- a/ghc/compiler/codeGen/ClosureInfo.lhs +++ b/ghc/compiler/codeGen/ClosureInfo.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: ClosureInfo.lhs,v 1.38 1999/05/18 15:03:50 simonpj Exp $ +% $Id: ClosureInfo.lhs,v 1.39 1999/11/02 15:05:44 simonmar Exp $ % \section[ClosureInfo]{Data structures which describe closures} @@ -77,7 +77,8 @@ import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel, mkReturnPtLabel ) import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling, - opt_Parallel, opt_DoTickyProfiling ) + opt_Parallel, opt_DoTickyProfiling, + opt_SMP ) import Id ( Id, idType, getIdArity ) import DataCon ( DataCon, dataConTag, fIRST_TAG, isNullaryDataCon, isTupleCon, dataConName @@ -679,6 +680,9 @@ getEntryConvention name lf_info arg_kinds LFThunk _ _ _ updatable std_form_info _ _ -> if updatable || opt_DoTickyProfiling -- to catch double entry + || opt_SMP -- always enter via node on SMP, since the + -- thunk might have been blackholed in the + -- meantime. then ViaNode else StdEntry (thunkEntryLabel name std_form_info updatable) |