ghc/compiler/codeGen/CgUpdate.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   3 %
   4 \section[CgUpdate]{Manipulating update frames}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module CgUpdate (
  10         pushUpdateFrame -- OLD: , evalPushRCCFrame
  11     ) where
  12
  13 import StgSyn
  14 import CgMonad
  15 import AbsCSyn
  16
  17 import CgCompInfo       ( sTD_UF_SIZE, cON_UF_SIZE,
  18                           sCC_STD_UF_SIZE, sCC_CON_UF_SIZE,
  19                           spARelToInt, spBRelToInt
  20                         )
  21 import CgStackery       ( allocUpdateFrame )
  22 import CgUsages
  23 import CmdLineOpts      ( GlobalSwitch(..) )
  24 import Util
  25 \end{code}
  26
  27
  28 %********************************************************
  29 %*                                                      *
  30 %*              Setting up update frames                *
  31 %*                                                      *
  32 %********************************************************
  33 \subsection[setting-update-frames]{Setting up update frames}
  34
  35 @pushUpdateFrame@ $updatee$ pushes a general update frame which
  36 points to $updatee$ as the thing to be updated.  It is only used
  37 when a thunk has just been entered, so the (real) stack pointers
  38 are guaranteed to be nicely aligned with the top of stack.
  39 @pushUpdateFrame@ adjusts the virtual and tail stack pointers
  40 to reflect the frame pushed.
  41
  42 \begin{code}
  43 pushUpdateFrame :: CAddrMode -> CAddrMode -> Code -> Code
  44
  45 pushUpdateFrame updatee vector code
  46   = isSwitchSetC SccProfilingOn         `thenFC` \ profiling_on ->
  47     let
  48         -- frame_size *includes* the return address
  49         frame_size = if profiling_on
  50                      then sCC_STD_UF_SIZE
  51                      else sTD_UF_SIZE
  52     in
  53     getEndOfBlockInfo                   `thenFC` \ eob_info ->
  54     ASSERT(case eob_info of { EndOfBlockInfo _ _ InRetReg -> True; _ -> False})
  55     allocUpdateFrame frame_size vector (\ _ ->
  56
  57                 -- Emit the push macro
  58             absC (CMacroStmt PUSH_STD_UPD_FRAME [
  59                         updatee,
  60                         int_CLit0,      -- Known to be zero because we have just
  61                         int_CLit0       -- entered a thunk
  62             ])
  63             `thenC` code
  64     )
  65
  66 int_CLit0 = mkIntCLit 0 -- out here to avoid pushUpdateFrame CAF (sigh)
  67
  68 {- ---------------------
  69     What actually happens is something like this; but it got macro-ised
  70
  71   = pushOnBStack (CReg CurCostCentre)                   `thenFC` \ _ ->
  72     pushOnBStack (CReg SuA)                             `thenFC` \ _ ->
  73     pushOnBStack (CReg SuB)                             `thenFC` \ _ ->
  74     pushOnBStack updatee                                `thenFC` \ _ ->
  75     pushOnBStack (CLabel sTD_UPD_RET_VEC_LABEL CodePtrKind) `thenFC` \ _ ->
  76
  77         -- MAKE SuA, SuB POINT TO TOP OF A,B STACKS
  78         -- Remember, SpB hasn't yet been incremented to account for the
  79         -- 4-word update frame which has been pushed.
  80         -- This code seems crude, but effective...
  81     absC (AbsCStmts (CAssign (CReg SuA) (CReg SpA))
  82                     (CAssign (CReg SuB) (CAddr (SpBRel 0 4))))
  83 -------------------------- -}
  84 \end{code}
  85
  86 @evalPushRCCFrame@ pushes a frame to restore the cost centre, and
  87 deallocates stuff from the A and B stack if evaluation profiling. No
  88 actual update is required so no closure to update is passed.
  89 @evalPushRCCFrame@ is called for an @scc@ expression and on entry to a
  90 single-entry thunk: no update reqd but cost centre manipulation is.
  91
  92 \begin{code}
  93 {- OLD: WDP: 94/06
  94
  95 evalPushRCCFrame :: Bool -> Code -> Code
  96
  97 evalPushRCCFrame prim code
  98   = isSwitchSetC SccProfiling_Eval      `thenFC` \ eval_profiling ->
  99
 100     if (not eval_profiling) then
 101         code
 102     else
 103
 104         -- Find out how many words of stack must will be
 105         --   deallocated at the end of the basic block
 106         -- As we push stuff onto the B stack we must make the
 107         -- RCC frame dealocate the B stack words
 108
 109         -- We dont actually push things onto the A stack so we
 110         --   can treat the A stack as if these words were not there
 111         --   i.e. we subtract them from the A stack offset
 112         -- They will be popped by the current block of code
 113
 114         -- Tell downstream code about the update frame on the B stack
 115     allocUpdateFrame
 116                 sCC_RCC_UF_SIZE
 117                 (panic "pushEvalRCCFrame: mkRestoreCostCentreLbl")
 118                 (\ (old_args_spa, old_args_spb, upd_frame_offset) ->
 119
 120     getSpARelOffset old_args_spa        `thenFC` \ old_args_spa_rel ->
 121     getSpBRelOffset upd_frame_offset    `thenFC` \ upd_frame_rel ->
 122
 123     let b_wds_to_pop = upd_frame_offset - old_args_spb
 124     in
 125
 126         -- Allocate enough space on the B stack for the frame
 127
 128     evalCostCentreC
 129              (if prim then
 130                      "PUSH_RCC_FRAME_RETURN"
 131                  else
 132                      "PUSH_RCC_FRAME_VECTOR")
 133              [
 134                 mkIntCLit (spARelToInt old_args_spa_rel),
 135                         {- Place on A stack to ``draw the line'' -}
 136                 mkIntCLit (spBRelToInt upd_frame_rel),
 137                         {- Ditto B stk.  The update frame is pushed starting
 138                            just above here -}
 139                 mkIntCLit 0,
 140                         {- Number of words of A below the line, which must be
 141                            popped to get to the tail-call position -}
 142                 mkIntCLit b_wds_to_pop
 143                         {- Ditto B stk -}
 144              ]                          `thenC`
 145
 146     code
 147
 148
 149         -- If we actually pushed things onto the A stack we have
 150         --   to arrange for the RCC frame to pop these as well
 151         -- Would need to tell downstream code about the update frame
 152         --   both the A and B stacks
 153     )
 154 -}
 155 \end{code}