ghc/compiler/codeGen/CgUsages.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[CgUsages]{Accessing and modifying stacks and heap usage info}
   5
   6 This module provides the functions to access (\tr{get*} functions) and
   7 modify (\tr{set*} functions) the stacks and heap usage information.
   8
   9 \begin{code}
  10 module CgUsages (
  11         initHeapUsage, setVirtHp, getVirtAndRealHp, setRealHp,
  12         setRealAndVirtualSp,
  13
  14         getVirtSp, getRealSp,
  15
  16         getHpRelOffset, getSpRelOffset,
  17
  18         adjustSpAndHp
  19     ) where
  20
  21 #include "HsVersions.h"
  22
  23 import AbsCSyn
  24 import PrimRep          ( PrimRep(..) )
  25 import AbsCUtils        ( mkAbstractCs )
  26 import CgMonad
  27 \end{code}
  28
  29 %************************************************************************
  30 %*                                                                      *
  31 \subsection[CgUsages-heapery]{Monad things for fiddling with heap usage}
  32 %*                                                                      *
  33 %************************************************************************
  34
  35 @initHeapUsage@ applies a function to the amount of heap that it uses.
  36 It initialises the heap usage to zeros, and passes on an unchanged
  37 heap usage.
  38
  39 It is usually a prelude to performing a GC check, so everything must
  40 be in a tidy and consistent state.
  41
  42 \begin{code}
  43 initHeapUsage :: (VirtualHeapOffset -> Code) -> Code
  44
  45 initHeapUsage fcode info_down (MkCgState absC binds (stk_usage, heap_usage))
  46   = state3
  47   where
  48     state1 = MkCgState absC binds (stk_usage, (0, 0))
  49     state2 = fcode (heapHWM heap_usage2) info_down state1
  50     (MkCgState absC2 binds2 (stk_usage2, heap_usage2)) = state2
  51     state3 = MkCgState  absC2
  52                         binds2
  53                         (stk_usage2, heap_usage {- unchanged -})
  54 \end{code}
  55
  56 \begin{code}
  57 setVirtHp :: VirtualHeapOffset -> Code
  58 setVirtHp new_virtHp info_down
  59           state@(MkCgState absC binds (stk, (virtHp, realHp)))
  60   = MkCgState absC binds (stk, (new_virtHp, realHp))
  61 \end{code}
  62
  63 \begin{code}
  64 getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
  65 getVirtAndRealHp info_down state@(MkCgState _ _ (_, (virtHp, realHp)))
  66   = ((virtHp, realHp), state)
  67 \end{code}
  68
  69 \begin{code}
  70 setRealHp ::  VirtualHeapOffset -> Code
  71 setRealHp realHp info_down (MkCgState absC binds (stk_usage, (vHp, _)))
  72   = MkCgState absC binds (stk_usage, (vHp, realHp))
  73 \end{code}
  74
  75 \begin{code}
  76 getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative
  77 getHpRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,realHp)))
  78   = (hpRel realHp virtual_offset, state)
  79 \end{code}
  80
  81 The heap high water mark is the larger of virtHp and hwHp.  The latter is
  82 only records the high water marks of forked-off branches, so to find the
  83 heap high water mark you have to take the max of virtHp and hwHp.  Remember,
  84 virtHp never retreats!
  85
  86 \begin{code}
  87 heapHWM (virtHp, realHp) = virtHp
  88 \end{code}
  89
  90 %************************************************************************
  91 %*                                                                      *
  92 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
  93 %*                                                                      *
  94 %************************************************************************
  95
  96 @setRealAndVirtualSp@ sets into the environment the offsets of the
  97 current position of the real and virtual stack pointers in the current
  98 stack frame.  The high-water mark is set too.  It generates no code.
  99 It is used to initialise things at the beginning of a closure body.
 100
 101 \begin{code}
 102 setRealAndVirtualSp :: VirtualSpOffset  -- New real Sp
 103                      -> Code
 104
 105 setRealAndVirtualSp sp info_down (MkCgState absC binds
 106                                         ((vsp,f,realSp,hwsp), h_usage))
 107   = MkCgState absC binds new_usage
 108   where
 109     new_usage = ((sp, f, sp, sp), h_usage)
 110 \end{code}
 111
 112 \begin{code}
 113 getVirtSp :: FCode VirtualSpOffset
 114 getVirtSp info_down state@(MkCgState absC binds ((virtSp,_,_,_), _))
 115   = (virtSp, state)
 116
 117 getRealSp :: FCode VirtualSpOffset
 118 getRealSp info_down state@(MkCgState absC binds ((_,_,realSp,_),_))
 119   = (realSp,state)
 120 \end{code}
 121
 122 \begin{code}
 123 getSpRelOffset :: VirtualSpOffset -> FCode RegRelative
 124 getSpRelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSp,_),_))
 125   = (spRel realSp virtual_offset, state)
 126 \end{code}
 127
 128 %************************************************************************
 129 %*                                                                      *
 130 \subsection[CgStackery-adjust]{Adjusting the stack pointers}
 131 %*                                                                      *
 132 %************************************************************************
 133
 134 This function adjusts the stack and heap pointers just before a tail
 135 call or return.  The stack pointer is adjusted to its final position
 136 (i.e. to point to the last argument for a tail call, or the activation
 137 record for a return).  The heap pointer may be moved backwards, in
 138 cases where we overallocated at the beginning of the basic block (see
 139 CgCase.lhs for discussion).
 140
 141 These functions {\em do not} deal with high-water-mark adjustment.
 142 That's done by functions which allocate stack space.
 143
 144 \begin{code}
 145 adjustSpAndHp :: VirtualSpOffset        -- New offset for Arg stack ptr
 146               -> Code
 147 adjustSpAndHp newRealSp (MkCgInfoDown _ _ _ ticky_ctr _)
 148                         (MkCgState absC binds
 149                                    ((vSp,fSp,realSp,hwSp),
 150                                    (vHp, rHp)))
 151   = MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage
 152     where
 153
 154     move_sp = if (newRealSp == realSp) then AbsCNop
 155               else (CAssign (CReg Sp)
 156                             (CAddr (spRel realSp newRealSp)))
 157
 158         -- Adjust the heap pointer backwards in case we over-allocated
 159         -- Analogously, we also remove bytes from the ticky counter
 160     move_hp = if (rHp == vHp) then AbsCNop
 161               else mkAbstractCs [
 162                         CAssign (CReg Hp) (CAddr (hpRel rHp vHp)),
 163                         profCtrAbsC SLIT("TICK_ALLOC_HEAP")
 164                             [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ]
 165               ]
 166
 167     new_usage = ((vSp, fSp, newRealSp, hwSp), (vHp,vHp))
 168 \end{code}