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 rje: Note the slightly suble fixed point behaviour needed here
  43 \begin{code}
  44 initHeapUsage :: (VirtualHeapOffset -> Code) -> Code
  45
  46 initHeapUsage fcode = do
  47         (stk_usage, heap_usage) <- getUsage
  48         setUsage (stk_usage, (0,0))
  49         fixC (\heap_usage2 -> do
  50                 fcode (heapHWM heap_usage2)
  51                 (_, heap_usage2) <- getUsage
  52                 return heap_usage2)
  53         (stk_usage2, heap_usage2) <- getUsage
  54         setUsage (stk_usage2, heap_usage {-unchanged -})
  55 \end{code}
  56
  57 \begin{code}
  58 setVirtHp :: VirtualHeapOffset -> Code
  59 setVirtHp new_virtHp = do
  60         (stk, (virtHp, realHp)) <- getUsage
  61         setUsage (stk, (new_virtHp, realHp))
  62 \end{code}
  63
  64 \begin{code}
  65 getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
  66 getVirtAndRealHp = do
  67         (_, (virtHp, realHp)) <- getUsage
  68         return (virtHp, realHp)
  69 \end{code}
  70
  71 \begin{code}
  72 setRealHp ::  VirtualHeapOffset -> Code
  73 setRealHp realHp = do
  74         (stk_usage, (vHp, _)) <- getUsage
  75         setUsage (stk_usage, (vHp, realHp))
  76 \end{code}
  77
  78 \begin{code}
  79 getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative
  80 getHpRelOffset virtual_offset = do
  81         (_,(_,realHp)) <- getUsage
  82         return $ hpRel realHp virtual_offset
  83 \end{code}
  84
  85 The heap high water mark is the larger of virtHp and hwHp.  The latter is
  86 only records the high water marks of forked-off branches, so to find the
  87 heap high water mark you have to take the max of virtHp and hwHp.  Remember,
  88 virtHp never retreats!
  89
  90 \begin{code}
  91 heapHWM (virtHp, realHp) = virtHp
  92 \end{code}
  93
  94 %************************************************************************
  95 %*                                                                      *
  96 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
  97 %*                                                                      *
  98 %************************************************************************
  99
 100 @setRealAndVirtualSp@ sets into the environment the offsets of the
 101 current position of the real and virtual stack pointers in the current
 102 stack frame.  The high-water mark is set too.  It generates no code.
 103 It is used to initialise things at the beginning of a closure body.
 104
 105 \begin{code}
 106 setRealAndVirtualSp :: VirtualSpOffset  -- New real Sp
 107                      -> Code
 108
 109 setRealAndVirtualSp sp = do
 110         ((vsp,frame,f,realSp,hwsp), h_usage) <- getUsage
 111         let new_usage = ((sp, frame, f, sp, sp), h_usage)
 112         setUsage new_usage
 113 \end{code}
 114
 115 \begin{code}
 116 getVirtSp :: FCode VirtualSpOffset
 117 getVirtSp = do
 118         ((virtSp,_,_,_,_), _) <- getUsage
 119         return virtSp
 120
 121 getRealSp :: FCode VirtualSpOffset
 122 getRealSp = do
 123         ((_,_,_,realSp,_),_) <- getUsage
 124         return realSp
 125 \end{code}
 126
 127 \begin{code}
 128 getSpRelOffset :: VirtualSpOffset -> FCode RegRelative
 129 getSpRelOffset virtual_offset = do
 130         ((_,_,_,realSp,_),_) <- getUsage
 131         return $ spRel realSp virtual_offset
 132 \end{code}
 133
 134 %************************************************************************
 135 %*                                                                      *
 136 \subsection[CgStackery-adjust]{Adjusting the stack pointers}
 137 %*                                                                      *
 138 %************************************************************************
 139
 140 This function adjusts the stack and heap pointers just before a tail
 141 call or return.  The stack pointer is adjusted to its final position
 142 (i.e. to point to the last argument for a tail call, or the activation
 143 record for a return).  The heap pointer may be moved backwards, in
 144 cases where we overallocated at the beginning of the basic block (see
 145 CgCase.lhs for discussion).
 146
 147 These functions {\em do not} deal with high-water-mark adjustment.
 148 That's done by functions which allocate stack space.
 149
 150 \begin{code}
 151 adjustSpAndHp :: VirtualSpOffset        -- New offset for Arg stack ptr
 152               -> Code
 153 adjustSpAndHp newRealSp = do
 154         (MkCgInfoDown _ _ _ ticky_ctr _) <- getInfoDown
 155         (MkCgState absC binds
 156                    ((vSp,frame,fSp,realSp,hwSp),
 157                    (vHp, rHp))) <- getState
 158         let move_sp = if (newRealSp == realSp) then AbsCNop
 159               else (CAssign (CReg Sp)
 160                             (CAddr (spRel realSp newRealSp)))
 161         let move_hp =
 162                 if (rHp == vHp) then AbsCNop
 163                 else mkAbstractCs [
 164                 CAssign (CReg Hp) (CAddr (hpRel rHp vHp)),
 165                         profCtrAbsC FSLIT("TICK_ALLOC_HEAP")
 166                         [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ]
 167                 ]
 168         let new_usage = ((vSp, frame, fSp, newRealSp, hwSp), (vHp,vHp))
 169         setState $ MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage
 170 \end{code}