diff options
Diffstat (limited to 'ghc/compiler/codeGen')
| -rw-r--r-- | ghc/compiler/codeGen/CgCase.lhs | 3 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgClosure.lhs | 17 | ||||
| -rw-r--r-- | ghc/compiler/codeGen/CgUsages.lhs | 17 |
3 files changed, 27 insertions, 10 deletions
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs index b7c092cf93..4e755ca7c1 100644 --- a/ghc/compiler/codeGen/CgCase.lhs +++ b/ghc/compiler/codeGen/CgCase.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgCase.lhs,v 1.35 1999/10/13 16:39:14 simonmar Exp $ +% $Id: CgCase.lhs,v 1.36 1999/11/01 17:10:06 simonpj Exp $ % %******************************************************** %* * @@ -174,6 +174,7 @@ cgCase (StgCon (PrimOp op) args res_ty) } `thenC` -- bind the default binder if necessary + -- The deadness info is set by StgVarInfo (if (isDeadBinder bndr) then nopC else bindNewToTemp bndr `thenFC` \ bndr_amode -> diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index 71a2c06f4b..dc326087c9 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.35 1999/10/13 16:39:15 simonmar Exp $ +% $Id: CgClosure.lhs,v 1.36 1999/11/01 17:10:07 simonpj Exp $ % \section[CgClosure]{Code generation for closures} @@ -46,7 +46,7 @@ import ClosureInfo -- lots and lots of stuff import CmdLineOpts ( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling ) import CostCentre import Id ( Id, idName, idType, idPrimRep ) -import Name ( Name ) +import Name ( Name, isLocalName ) import Module ( Module, pprModule ) import ListSetOps ( minusList ) import PrimRep ( PrimRep(..) ) @@ -372,9 +372,10 @@ closureCodeBody binder_info closure_info cc all_args body -- fast_entry_code = forceHeapCheck [] True fast_entry_code' fast_entry_code - = profCtrC SLIT("TICK_CTR") [ + = moduleName `thenFC` \ mod_name -> + profCtrC SLIT("TICK_CTR") [ CLbl ticky_ctr_label DataPtrRep, - mkCString (_PK_ (showSDocDebug (ppr name))), + mkCString (_PK_ (ppr_for_ticky_name mod_name name)), mkIntCLit stg_arity, -- total # of args mkIntCLit sp_stk_args, -- # passed on stk mkCString (_PK_ (map (showTypeCategory . idType) all_args)) @@ -437,6 +438,14 @@ closureCodeBody binder_info closure_info cc all_args body name = closureName closure_info fast_label = mkFastEntryLabel name stg_arity info_label = mkInfoTableLabel name + + +-- When printing the name of a thing in a ticky file, we want to +-- give the module name even for *local* things. We print +-- just "x (M)" rather that "M.x" to distinguish them from the global kind. +ppr_for_ticky_name mod_name name + | isLocalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name))) + | otherwise = showSDocDebug (ppr name) \end{code} For lexically scoped profiling we have to load the cost centre from diff --git a/ghc/compiler/codeGen/CgUsages.lhs b/ghc/compiler/codeGen/CgUsages.lhs index ce20791ee7..6f3353d8dd 100644 --- a/ghc/compiler/codeGen/CgUsages.lhs +++ b/ghc/compiler/codeGen/CgUsages.lhs @@ -21,6 +21,7 @@ module CgUsages ( #include "HsVersions.h" import AbsCSyn +import PrimRep ( PrimRep(..) ) import AbsCUtils ( mkAbstractCs ) import CgMonad \end{code} @@ -143,9 +144,10 @@ That's done by functions which allocate stack space. \begin{code} adjustSpAndHp :: VirtualSpOffset -- New offset for Arg stack ptr -> Code -adjustSpAndHp newRealSp info_down (MkCgState absC binds - ((vSp,fSp,realSp,hwSp), - (vHp, rHp))) +adjustSpAndHp newRealSp (MkCgInfoDown _ _ _ ticky_ctr _) + (MkCgState absC binds + ((vSp,fSp,realSp,hwSp), + (vHp, rHp))) = MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage where @@ -153,9 +155,14 @@ adjustSpAndHp newRealSp info_down (MkCgState absC binds else (CAssign (CReg Sp) (CAddr (spRel realSp newRealSp))) + -- Adjust the heap pointer backwards in case we over-allocated + -- Analogously, we also remove bytes from the ticky counter move_hp = if (rHp == vHp) then AbsCNop - else (CAssign (CReg Hp) - (CAddr (hpRel rHp vHp))) + else mkAbstractCs [ + CAssign (CReg Hp) (CAddr (hpRel rHp vHp)), + profCtrAbsC SLIT("TICK_ALLOC_HEAP") + [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ] + ] new_usage = ((vSp, fSp, newRealSp, hwSp), (vHp,vHp)) \end{code} |