ghc/compiler/codeGen/CgUsages.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   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         setRealAndVirtualSps,
  13
  14         getVirtSps,
  15
  16         getHpRelOffset, getSpARelOffset, getSpBRelOffset,
  17
  18         freeBStkSlot
  19     ) where
  20
  21 import Ubiq{-uitous-}
  22 import CgLoop1  -- here for paranoia-checking
  23
  24 import AbsCSyn          ( RegRelative(..), AbstractC, CAddrMode )
  25 import CgMonad
  26 import HeapOffs         ( zeroOff,
  27                           VirtualHeapOffset(..),
  28                           VirtualSpAOffset(..),
  29                           VirtualSpBOffset(..)
  30                         )
  31 import Id               ( IdEnv(..) )
  32 \end{code}
  33
  34 %************************************************************************
  35 %*                                                                      *
  36 \subsection[CgUsages-heapery]{Monad things for fiddling with heap usage}
  37 %*                                                                      *
  38 %************************************************************************
  39
  40 @initHeapUsage@ applies a function to the amount of heap that it uses.
  41 It initialises the heap usage to zeros, and passes on an unchanged
  42 heap usage.
  43
  44 It is usually a prelude to performing a GC check, so everything must
  45 be in a tidy and consistent state.
  46
  47 \begin{code}
  48 initHeapUsage :: (VirtualHeapOffset -> Code) -> Code
  49
  50 initHeapUsage fcode info_down (MkCgState absC binds (a_usage, b_usage, heap_usage))
  51   = state3
  52   where
  53     state1 = MkCgState absC binds (a_usage, b_usage, (zeroOff, zeroOff))
  54     state2 = fcode (heapHWM heap_usage2) info_down state1
  55     (MkCgState absC2 binds2 (a_usage2, b_usage2, heap_usage2)) = state2
  56     state3 = MkCgState  absC2
  57                         binds2
  58                         (a_usage2, b_usage2, heap_usage {- unchanged -})
  59 \end{code}
  60
  61 \begin{code}
  62 setVirtHp :: VirtualHeapOffset -> Code
  63 setVirtHp new_virtHp info_down
  64           state@(MkCgState absC binds (a_stk, b_stk, (virtHp, realHp)))
  65   = MkCgState absC binds (a_stk, b_stk, (new_virtHp, realHp))
  66 \end{code}
  67
  68 \begin{code}
  69 getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
  70 getVirtAndRealHp info_down state@(MkCgState _ _ (au, bu, (virtHp, realHp)))
  71   = ((virtHp, realHp), state)
  72 \end{code}
  73
  74 \begin{code}
  75 setRealHp ::  VirtualHeapOffset -> Code
  76 setRealHp realHp info_down (MkCgState absC binds (au, bu, (vHp, _)))
  77   = MkCgState absC binds (au, bu, (vHp, realHp))
  78 \end{code}
  79
  80 \begin{code}
  81 getHpRelOffset :: VirtualHeapOffset -> FCode RegRelative
  82 getHpRelOffset virtual_offset info_down state@(MkCgState _ _ (_,_,(_,realHp)))
  83   = (HpRel realHp virtual_offset, state)
  84 \end{code}
  85
  86 The heap high water mark is the larger of virtHp and hwHp.  The latter is
  87 only records the high water marks of forked-off branches, so to find the
  88 heap high water mark you have to take the max of virtHp and hwHp.  Remember,
  89 virtHp never retreats!
  90
  91 \begin{code}
  92 heapHWM (virtHp, realHp) = virtHp
  93 \end{code}
  94
  95 %************************************************************************
  96 %*                                                                      *
  97 \subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
  98 %*                                                                      *
  99 %************************************************************************
 100
 101 @setRealAndVirtualSps@ sets into the environment the offsets of the
 102 current position of the real and virtual stack pointers in the current
 103 stack frame.  The high-water mark is set too.  It generates no code.
 104 It is used to initialise things at the beginning of a closure body.
 105
 106 \begin{code}
 107 setRealAndVirtualSps :: VirtualSpAOffset        -- New real SpA
 108                      -> VirtualSpBOffset        -- Ditto B stack
 109                      -> Code
 110
 111 setRealAndVirtualSps spA spB info_down (MkCgState absC binds
 112                                         ((vspA,fA,realSpA,hwspA),
 113                                          (vspB,fB,realSpB,hwspB),
 114                                          h_usage))
 115   = MkCgState absC binds new_usage
 116   where
 117     new_usage = ((spA, fA, spA, spA),
 118                  (spB, fB, spB, spB),
 119                  h_usage)
 120 \end{code}
 121
 122 \begin{code}
 123 getVirtSps :: FCode (VirtualSpAOffset,VirtualSpBOffset)
 124 getVirtSps info_down state@(MkCgState absC binds ((virtSpA,_,_,_), (virtSpB,_,_,_), _))
 125   = ((virtSpA,virtSpB), state)
 126 \end{code}
 127
 128 \begin{code}
 129 getSpARelOffset :: VirtualSpAOffset -> FCode RegRelative
 130 getSpARelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSpA,_),_,_))
 131   = (SpARel realSpA virtual_offset, state)
 132
 133 getSpBRelOffset :: VirtualSpBOffset -> FCode RegRelative
 134 getSpBRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,_,realSpB,_),_))
 135   = (SpBRel realSpB virtual_offset, state)
 136 \end{code}
 137
 138 \begin{code}
 139 freeBStkSlot :: VirtualSpBOffset -> Code
 140 freeBStkSlot b_slot info_down
 141         state@(MkCgState absC binds (spa_usage, (virtSpB,free_b,realSpB,hwSpB), heap_usage))
 142   = MkCgState absC binds (spa_usage, (virtSpB,new_free_b,realSpB,hwSpB), heap_usage)
 143   where
 144     new_free_b = addFreeBSlots free_b [b_slot]
 145 \end{code}