ghc/compiler/codeGen/CgLetNoEscape.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 % $Id: CgLetNoEscape.lhs,v 1.17 2002/09/04 10:00:46 simonmar Exp $
   5 %
   6 %********************************************************
   7 %*                                                      *
   8 \section[CgLetNoEscape]{Handling ``let-no-escapes''}
   9 %*                                                      *
  10 %********************************************************
  11
  12 \begin{code}
  13 module CgLetNoEscape ( cgLetNoEscapeClosure ) where
  14
  15 #include "HsVersions.h"
  16
  17 import {-# SOURCE #-} CgExpr ( cgExpr )
  18
  19 import StgSyn
  20 import CgMonad
  21 import AbsCSyn
  22
  23 import CgBindery        ( letNoEscapeIdInfo, bindArgsToRegs,
  24                           bindNewToStack, buildContLivenessMask, CgIdInfo,
  25                           nukeDeadBindings
  26                         )
  27 import CgHeapery        ( altHeapCheck )
  28 import CgRetConv        ( assignRegs )
  29 import CgStackery       ( mkTaggedVirtStkOffsets,
  30                           allocStackTop, deAllocStackTop, freeStackSlots )
  31 import CgUsages         ( setRealAndVirtualSp, getRealSp, getSpRelOffset )
  32 import CLabel           ( mkReturnInfoLabel )
  33 import ClosureInfo      ( mkLFLetNoEscape )
  34 import CostCentre       ( CostCentreStack )
  35 import Id               ( idPrimRep, Id )
  36 import Var              ( idUnique )
  37 import PrimRep          ( PrimRep(..), retPrimRepSize )
  38 import BasicTypes       ( RecFlag(..) )
  39 import Unique           ( Unique )
  40 import Util             ( splitAtList )
  41 \end{code}
  42
  43 %************************************************************************
  44 %*                                                                      *
  45 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
  46 %*                                                                      *
  47 %************************************************************************
  48
  49 [The {\em code} that detects these things is elsewhere.]
  50
  51 Consider:
  52 \begin{verbatim}
  53         let x = fvs \ args -> e
  54         in
  55                 if ... then x else
  56                 if ... then x else ...
  57 \end{verbatim}
  58 @x@ is used twice (so we probably can't unfold it), but when it is
  59 entered, the stack is deeper than it was when the definition of @x@
  60 happened.  Specifically, if instead of allocating a closure for @x@,
  61 we saved all @x@'s fvs on the stack, and remembered the stack depth at
  62 that moment, then whenever we enter @x@ we can simply set the stack
  63 pointer(s) to these remembered (compile-time-fixed) values, and jump
  64 to the code for @x@.
  65
  66 All of this is provided x is:
  67 \begin{enumerate}
  68 \item
  69 non-updatable;
  70 \item
  71 guaranteed to be entered before the stack retreats -- ie x is not
  72 buried in a heap-allocated closure, or passed as an argument to something;
  73 \item
  74 all the enters have exactly the right number of arguments,
  75 no more no less;
  76 \item
  77 all the enters are tail calls; that is, they return to the
  78 caller enclosing the definition of @x@.
  79 \end{enumerate}
  80
  81 Under these circumstances we say that @x@ is {\em non-escaping}.
  82
  83 An example of when (4) does {\em not} hold:
  84 \begin{verbatim}
  85         let x = ...
  86         in case x of ...alts...
  87 \end{verbatim}
  88
  89 Here, @x@ is certainly entered only when the stack is deeper than when
  90 @x@ is defined, but here it must return to \tr{...alts...} So we can't
  91 just adjust the stack down to @x@'s recalled points, because that
  92 would lost @alts@' context.
  93
  94 Things can get a little more complicated.  Consider:
  95 \begin{verbatim}
  96         let y = ...
  97         in let x = fvs \ args -> ...y...
  98         in ...x...
  99 \end{verbatim}
 100
 101 Now, if @x@ is used in a non-escaping way in \tr{...x...}, {\em and}
 102 @y@ is used in a non-escaping way in \tr{...y...}, {\em then} @y@ is
 103 non-escaping.
 104
 105 @x@ can even be recursive!  Eg:
 106 \begin{verbatim}
 107         letrec x = [y] \ [v] -> if v then x True else ...
 108         in
 109                 ...(x b)...
 110 \end{verbatim}
 111
 112
 113 %************************************************************************
 114 %*                                                                      *
 115 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
 116 %*                                                                      *
 117 %************************************************************************
 118
 119
 120 Generating code for this is fun.  It is all very very similar to what
 121 we do for a case expression.  The duality is between
 122 \begin{verbatim}
 123         let-no-escape x = b
 124         in e
 125 \end{verbatim}
 126 and
 127 \begin{verbatim}
 128         case e of ... -> b
 129 \end{verbatim}
 130
 131 That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like
 132 the alternative of the case; it needs to be compiled in an environment
 133 in which all volatile bindings are forgotten, and the free vars are
 134 bound only to stable things like stack locations..  The @e@ part will
 135 execute {\em next}, just like the scrutinee of a case.
 136
 137 First, we need to save all @x@'s free vars
 138 on the stack, if they aren't there already.
 139
 140 \begin{code}
 141 cgLetNoEscapeClosure
 142         :: Id                   -- binder
 143         -> CostCentreStack      -- NB: *** NOT USED *** ToDo (WDP 94/06)
 144         -> StgBinderInfo        -- NB: ditto
 145         -> SRT
 146         -> StgLiveVars          -- variables live in RHS, including the binders
 147                                 -- themselves in the case of a recursive group
 148         -> EndOfBlockInfo       -- where are we going to?
 149         -> Maybe VirtualSpOffset -- Slot for current cost centre
 150         -> RecFlag              -- is the binding recursive?
 151         -> [Id]                 -- args (as in \ args -> body)
 152         -> StgExpr              -- body (as in above)
 153         -> FCode (Id, CgIdInfo)
 154
 155 -- ToDo: deal with the cost-centre issues
 156
 157 cgLetNoEscapeClosure
 158         binder cc binder_info srt full_live_in_rhss
 159         rhs_eob_info cc_slot rec args body
 160   = let
 161         arity   = length args
 162         lf_info = mkLFLetNoEscape arity
 163         uniq    = idUnique binder
 164     in
 165
 166     -- saveVolatileVarsAndRegs done earlier in cgExpr.
 167
 168     forkEvalHelp
 169         rhs_eob_info
 170
 171         (allocStackTop retPrimRepSize   `thenFC` \_ ->
 172          nukeDeadBindings full_live_in_rhss)
 173
 174         (deAllocStackTop retPrimRepSize         `thenFC` \_ ->
 175          buildContLivenessMask uniq             `thenFC` \ liveness ->
 176          forkAbsC (cgLetNoEscapeBody binder cc args body uniq)
 177                                                 `thenFC` \ code ->
 178          getSRTInfo srt                         `thenFC` \ srt_info ->
 179          absC (CRetDirect uniq code srt_info liveness)
 180                 `thenC` returnFC ())
 181                                         `thenFC` \ (vSp, _) ->
 182
 183     returnFC (binder, letNoEscapeIdInfo binder vSp lf_info)
 184 \end{code}
 185
 186 \begin{code}
 187 cgLetNoEscapeBody :: Id
 188                   -> CostCentreStack
 189                   -> [Id]       -- Args
 190                   -> StgExpr    -- Body
 191                   -> Unique     -- Unique for entry label
 192                   -> Code
 193
 194 cgLetNoEscapeBody binder cc all_args body uniq
 195    =
 196      -- this is where the stack frame lives:
 197      getRealSp   `thenFC` \sp ->
 198
 199      let
 200         arg_kinds            = map idPrimRep all_args
 201         (arg_regs, _)        = assignRegs [{-nothing live-}] arg_kinds
 202         (reg_args, stk_args) = splitAtList arg_regs all_args
 203
 204         (sp_stk_args, stk_offsets, stk_tags)
 205           = mkTaggedVirtStkOffsets sp idPrimRep stk_args
 206      in
 207
 208         -- Bind args to appropriate regs/stk locns
 209      bindArgsToRegs reg_args arg_regs               `thenC`
 210      mapCs bindNewToStack stk_offsets               `thenC`
 211      setRealAndVirtualSp sp_stk_args                `thenC`
 212
 213         -- free up the stack slots containing tags, and the slot
 214         -- containing the return address (really frame header).
 215         -- c.f. CgCase.cgUnboxedTupleAlt.
 216      freeStackSlots (sp : map fst stk_tags)         `thenC`
 217
 218         -- Enter the closures cc, if required
 219      --enterCostCentreCode closure_info cc IsFunction  `thenC`
 220
 221         -- fill in the frame header only if we fail a heap check:
 222         -- otherwise it isn't needed.
 223      getSpRelOffset sp                  `thenFC` \sp_rel ->
 224      let lbl = mkReturnInfoLabel uniq
 225          frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
 226      in
 227
 228         -- Do heap check [ToDo: omit for non-recursive case by recording in
 229         --      in envt and absorbing at call site]
 230      altHeapCheck False True arg_regs stk_tags frame_hdr_asst (Just uniq) (
 231         cgExpr body
 232      )
 233
 234 \end{code}