X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgUsages.lhs;h=c8b98f696d546502299ea3f29bf8994d47bdad08;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=eec6be60672ffd8f847cb11580b9553feecbea41;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgUsages.lhs b/ghc/compiler/codeGen/CgUsages.lhs index eec6be6..c8b98f6 100644 --- a/ghc/compiler/codeGen/CgUsages.lhs +++ b/ghc/compiler/codeGen/CgUsages.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[CgUsages]{Accessing and modifying stacks and heap usage info} @@ -9,26 +9,21 @@ modify (\tr{set*} functions) the stacks and heap usage information. \begin{code} module CgUsages ( initHeapUsage, setVirtHp, getVirtAndRealHp, setRealHp, - setRealAndVirtualSps, + setRealAndVirtualSp, - getVirtSps, + getVirtSp, getRealSp, - getHpRelOffset, getSpARelOffset, getSpBRelOffset, + getHpRelOffset, getSpRelOffset, - freeBStkSlot + adjustSpAndHp ) where -import Ubiq{-uitous-} -import CgLoop1 -- here for paranoia-checking +#include "HsVersions.h" -import AbsCSyn ( RegRelative(..), AbstractC, CAddrMode ) +import AbsCSyn +import PrimRep ( PrimRep(..) ) +import AbsCUtils ( mkAbstractCs ) import CgMonad -import HeapOffs ( zeroOff, - VirtualHeapOffset(..), - VirtualSpAOffset(..), - VirtualSpBOffset(..) - ) -import Id ( IdEnv(..) ) \end{code} %************************************************************************ @@ -44,43 +39,47 @@ heap usage. It is usually a prelude to performing a GC check, so everything must be in a tidy and consistent state. +rje: Note the slightly suble fixed point behaviour needed here \begin{code} initHeapUsage :: (VirtualHeapOffset -> Code) -> Code -initHeapUsage fcode info_down (MkCgState absC binds (a_usage, b_usage, heap_usage)) - = state3 - where - state1 = MkCgState absC binds (a_usage, b_usage, (zeroOff, zeroOff)) - state2 = fcode (heapHWM heap_usage2) info_down state1 - (MkCgState absC2 binds2 (a_usage2, b_usage2, heap_usage2)) = state2 - state3 = MkCgState absC2 - binds2 - (a_usage2, b_usage2, heap_usage {- unchanged -}) +initHeapUsage fcode = do + (stk_usage, heap_usage) <- getUsage + setUsage (stk_usage, (0,0)) + fixC (\heap_usage2 -> do + fcode (heapHWM heap_usage2) + (_, heap_usage2) <- getUsage + return heap_usage2) + (stk_usage2, heap_usage2) <- getUsage + setUsage (stk_usage2, heap_usage {-unchanged -}) \end{code} \begin{code} setVirtHp :: VirtualHeapOffset -> Code -setVirtHp new_virtHp info_down - state@(MkCgState absC binds (a_stk, b_stk, (virtHp, realHp))) - = MkCgState absC binds (a_stk, b_stk, (new_virtHp, realHp)) +setVirtHp new_virtHp = do + (stk, (virtHp, realHp)) <- getUsage + setUsage (stk, (new_virtHp, realHp)) \end{code} \begin{code} getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset) -getVirtAndRealHp info_down state@(MkCgState _ _ (au, bu, (virtHp, realHp))) - = ((virtHp, realHp), state) +getVirtAndRealHp = do + (_, (virtHp, realHp)) <- getUsage + return (virtHp, realHp) \end{code} \begin{code} setRealHp :: VirtualHeapOffset -> Code -setRealHp realHp info_down (MkCgState absC binds (au, bu, (vHp, _))) - = MkCgState absC binds (au, bu, (vHp, realHp)) +setRealHp realHp = do + (stk_usage, (vHp, _)) <- getUsage + setUsage (stk_usage, (vHp, realHp)) \end{code} \begin{code} getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative -getHpRelOffset virtual_offset info_down state@(MkCgState _ _ (_,_,(_,realHp))) - = (HpRel realHp virtual_offset, state) +getHpRelOffset virtual_offset = do + (_,(_,realHp)) <- getUsage + return $ hpRel realHp virtual_offset \end{code} The heap high water mark is the larger of virtHp and hwHp. The latter is @@ -98,48 +97,74 @@ heapHWM (virtHp, realHp) = virtHp %* * %************************************************************************ -@setRealAndVirtualSps@ sets into the environment the offsets of the +@setRealAndVirtualSp@ sets into the environment the offsets of the current position of the real and virtual stack pointers in the current stack frame. The high-water mark is set too. It generates no code. It is used to initialise things at the beginning of a closure body. \begin{code} -setRealAndVirtualSps :: VirtualSpAOffset -- New real SpA - -> VirtualSpBOffset -- Ditto B stack +setRealAndVirtualSp :: VirtualSpOffset -- New real Sp -> Code -setRealAndVirtualSps spA spB info_down (MkCgState absC binds - ((vspA,fA,realSpA,hwspA), - (vspB,fB,realSpB,hwspB), - h_usage)) - = MkCgState absC binds new_usage - where - new_usage = ((spA, fA, spA, spA), - (spB, fB, spB, spB), - h_usage) +setRealAndVirtualSp sp = do + ((vsp,frame,f,realSp,hwsp), h_usage) <- getUsage + let new_usage = ((sp, frame, f, sp, sp), h_usage) + setUsage new_usage \end{code} \begin{code} -getVirtSps :: FCode (VirtualSpAOffset,VirtualSpBOffset) -getVirtSps info_down state@(MkCgState absC binds ((virtSpA,_,_,_), (virtSpB,_,_,_), _)) - = ((virtSpA,virtSpB), state) +getVirtSp :: FCode VirtualSpOffset +getVirtSp = do + ((virtSp,_,_,_,_), _) <- getUsage + return virtSp + +getRealSp :: FCode VirtualSpOffset +getRealSp = do + ((_,_,_,realSp,_),_) <- getUsage + return realSp \end{code} \begin{code} -getSpARelOffset :: VirtualSpAOffset -> FCode RegRelative -getSpARelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSpA,_),_,_)) - = (SpARel realSpA virtual_offset, state) - -getSpBRelOffset :: VirtualSpBOffset -> FCode RegRelative -getSpBRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,_,realSpB,_),_)) - = (SpBRel realSpB virtual_offset, state) +getSpRelOffset :: VirtualSpOffset -> FCode RegRelative +getSpRelOffset virtual_offset = do + ((_,_,_,realSp,_),_) <- getUsage + return $ spRel realSp virtual_offset \end{code} +%************************************************************************ +%* * +\subsection[CgStackery-adjust]{Adjusting the stack pointers} +%* * +%************************************************************************ + +This function adjusts the stack and heap pointers just before a tail +call or return. The stack pointer is adjusted to its final position +(i.e. to point to the last argument for a tail call, or the activation +record for a return). The heap pointer may be moved backwards, in +cases where we overallocated at the beginning of the basic block (see +CgCase.lhs for discussion). + +These functions {\em do not} deal with high-water-mark adjustment. +That's done by functions which allocate stack space. + \begin{code} -freeBStkSlot :: VirtualSpBOffset -> Code -freeBStkSlot b_slot info_down - state@(MkCgState absC binds (spa_usage, (virtSpB,free_b,realSpB,hwSpB), heap_usage)) - = MkCgState absC binds (spa_usage, (virtSpB,new_free_b,realSpB,hwSpB), heap_usage) - where - new_free_b = addFreeBSlots free_b [b_slot] +adjustSpAndHp :: VirtualSpOffset -- New offset for Arg stack ptr + -> Code +adjustSpAndHp newRealSp = do + (MkCgInfoDown _ _ _ ticky_ctr _) <- getInfoDown + (MkCgState absC binds + ((vSp,frame,fSp,realSp,hwSp), + (vHp, rHp))) <- getState + let move_sp = if (newRealSp == realSp) then AbsCNop + else (CAssign (CReg Sp) + (CAddr (spRel realSp newRealSp))) + let move_hp = + if (rHp == vHp) then AbsCNop + else mkAbstractCs [ + CAssign (CReg Hp) (CAddr (hpRel rHp vHp)), + profCtrAbsC FSLIT("TICK_ALLOC_HEAP") + [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ] + ] + let new_usage = ((vSp, frame, fSp, newRealSp, hwSp), (vHp,vHp)) + setState $ MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage \end{code}