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