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
  20         -- and to make the interface self-sufficient...
  21         AbstractC, HeapOffset, RegRelative, CgState
  22     ) where
  23
  24 import AbsCSyn
  25 import CgMonad
  26 import Util
  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 (a_usage, b_usage, heap_usage))
  46   = state3
  47   where
  48     state1 = MkCgState absC binds (a_usage, b_usage, (zeroOff, zeroOff))
  49     state2 = fcode (heapHWM heap_usage2) info_down state1
  50     (MkCgState absC2 binds2 (a_usage2, b_usage2, heap_usage2)) = state2
  51     state3 = MkCgState  absC2
  52                         binds2
  53                         (a_usage2, b_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 (a_stk, b_stk, (virtHp, realHp)))
  60   = MkCgState absC binds (a_stk, b_stk, (new_virtHp, realHp))
  61 \end{code}
  62
  63 \begin{code}
  64 getVirtAndRealHp :: FCode (VirtualHeapOffset, VirtualHeapOffset)
  65 getVirtAndRealHp info_down state@(MkCgState _ _ (au, bu, (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 (au, bu, (vHp, _)))
  72   = MkCgState absC binds (au, bu, (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 @setRealAndVirtualSps@ 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 setRealAndVirtualSps :: VirtualSpAOffset        -- New real SpA
 103                      -> VirtualSpBOffset        -- Ditto B stack
 104                      -> Code
 105
 106 setRealAndVirtualSps spA spB info_down (MkCgState absC binds
 107                                         ((vspA,fA,realSpA,hwspA),
 108                                          (vspB,fB,realSpB,hwspB),
 109                                          h_usage))
 110   = MkCgState absC binds new_usage
 111   where
 112     new_usage = ((spA, fA, spA, spA),
 113                  (spB, fB, spB, spB),
 114                  h_usage)
 115 \end{code}
 116
 117 \begin{code}
 118 getVirtSps :: FCode (VirtualSpAOffset,VirtualSpBOffset)
 119 getVirtSps info_down state@(MkCgState absC binds ((virtSpA,_,_,_), (virtSpB,_,_,_), _))
 120   = ((virtSpA,virtSpB), state)
 121 \end{code}
 122
 123 \begin{code}
 124 getSpARelOffset :: VirtualSpAOffset -> FCode RegRelative
 125 getSpARelOffset virtual_offset info_down state@(MkCgState _ _ ((_,_,realSpA,_),_,_))
 126   = (SpARel realSpA virtual_offset, state)
 127
 128 getSpBRelOffset :: VirtualSpBOffset -> FCode RegRelative
 129 getSpBRelOffset virtual_offset info_down state@(MkCgState _ _ (_,(_,_,realSpB,_),_))
 130   = (SpBRel realSpB virtual_offset, state)
 131 \end{code}
 132
 133 \begin{code}
 134 freeBStkSlot :: VirtualSpBOffset -> Code
 135 freeBStkSlot b_slot info_down
 136         state@(MkCgState absC binds (spa_usage, (virtSpB,free_b,realSpB,hwSpB), heap_usage))
 137   = MkCgState absC binds (spa_usage, (virtSpB,new_free_b,realSpB,hwSpB), heap_usage)
 138   where
 139     new_free_b = addFreeBSlots free_b [b_slot]
 140 \end{code}