ghc/compiler/codeGen/CgLetNoEscape.lhs

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