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