ghc/compiler/codeGen/CgLetNoEscape.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 % $Id: CgLetNoEscape.lhs,v 1.11 1998/12/02 13:17:50 simonm 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 import CLabel           ( CLabel )
  23
  24 import CgBindery        ( letNoEscapeIdInfo, bindArgsToRegs,
  25                           bindNewToStack, buildContLivenessMask, CgIdInfo,
  26                           nukeDeadBindings
  27                         )
  28 import CgHeapery        ( altHeapCheck )
  29 import CgRetConv        ( assignRegs )
  30 import CgStackery       ( mkTaggedVirtStkOffsets,
  31                           allocStackTop, deAllocStackTop, freeStackSlots )
  32 import CgUsages         ( setRealAndVirtualSp, getRealSp, getSpRelOffset )
  33 import CLabel           ( mkReturnPtLabel )
  34 import ClosureInfo      ( mkLFLetNoEscape )
  35 import CostCentre       ( CostCentreStack )
  36 import Id               ( idPrimRep, Id )
  37 import Var              ( idUnique )
  38 import PrimRep          ( PrimRep(..), retPrimRepSize )
  39 import BasicTypes       ( RecFlag(..) )
  40 \end{code}
  41
  42 %************************************************************************
  43 %*                                                                      *
  44 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
  45 %*                                                                      *
  46 %************************************************************************
  47
  48 [The {\em code} that detects these things is elsewhere.]
  49
  50 Consider:
  51 \begin{verbatim}
  52         let x = fvs \ args -> e
  53         in
  54                 if ... then x else
  55                 if ... then x else ...
  56 \end{verbatim}
  57 @x@ is used twice (so we probably can't unfold it), but when it is
  58 entered, the stack is deeper than it was when the definition of @x@
  59 happened.  Specifically, if instead of allocating a closure for @x@,
  60 we saved all @x@'s fvs on the stack, and remembered the stack depth at
  61 that moment, then whenever we enter @x@ we can simply set the stack
  62 pointer(s) to these remembered (compile-time-fixed) values, and jump
  63 to the code for @x@.
  64
  65 All of this is provided x is:
  66 \begin{enumerate}
  67 \item
  68 non-updatable;
  69 \item
  70 guaranteed to be entered before the stack retreats -- ie x is not
  71 buried in a heap-allocated closure, or passed as an argument to something;
  72 \item
  73 all the enters have exactly the right number of arguments,
  74 no more no less;
  75 \item
  76 all the enters are tail calls; that is, they return to the
  77 caller enclosing the definition of @x@.
  78 \end{enumerate}
  79
  80 Under these circumstances we say that @x@ is {\em non-escaping}.
  81
  82 An example of when (4) does {\em not} hold:
  83 \begin{verbatim}
  84         let x = ...
  85         in case x of ...alts...
  86 \end{verbatim}
  87
  88 Here, @x@ is certainly entered only when the stack is deeper than when
  89 @x@ is defined, but here it must return to \tr{...alts...} So we can't
  90 just adjust the stack down to @x@'s recalled points, because that
  91 would lost @alts@' context.
  92
  93 Things can get a little more complicated.  Consider:
  94 \begin{verbatim}
  95         let y = ...
  96         in let x = fvs \ args -> ...y...
  97         in ...x...
  98 \end{verbatim}
  99
 100 Now, if @x@ is used in a non-escaping way in \tr{...x...}, {\em and}
 101 @y@ is used in a non-escaping way in \tr{...y...}, {\em then} @y@ is
 102 non-escaping.
 103
 104 @x@ can even be recursive!  Eg:
 105 \begin{verbatim}
 106         letrec x = [y] \ [v] -> if v then x True else ...
 107         in
 108                 ...(x b)...
 109 \end{verbatim}
 110
 111
 112 %************************************************************************
 113 %*                                                                      *
 114 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
 115 %*                                                                      *
 116 %************************************************************************
 117
 118
 119 Generating code for this is fun.  It is all very very similar to what
 120 we do for a case expression.  The duality is between
 121 \begin{verbatim}
 122         let-no-escape x = b
 123         in e
 124 \end{verbatim}
 125 and
 126 \begin{verbatim}
 127         case e of ... -> b
 128 \end{verbatim}
 129
 130 That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like
 131 the alternative of the case; it needs to be compiled in an environment
 132 in which all volatile bindings are forgotten, and the free vars are
 133 bound only to stable things like stack locations..  The @e@ part will
 134 execute {\em next}, just like the scrutinee of a case.
 135
 136 First, we need to save all @x@'s free vars
 137 on the stack, if they aren't there already.
 138
 139 \begin{code}
 140 cgLetNoEscapeClosure
 141         :: Id                   -- binder
 142         -> CostCentreStack      -- NB: *** NOT USED *** ToDo (WDP 94/06)
 143         -> StgBinderInfo        -- NB: ditto
 144         -> SRT
 145         -> StgLiveVars          -- variables live in RHS, including the binders
 146                                 -- themselves in the case of a recursive group
 147         -> EndOfBlockInfo       -- where are we going to?
 148         -> Maybe VirtualSpOffset -- Slot for current cost centre
 149         -> RecFlag              -- is the binding recursive?
 150         -> [Id]                 -- args (as in \ args -> body)
 151         -> StgExpr              -- body (as in above)
 152         -> FCode (Id, CgIdInfo)
 153
 154 -- ToDo: deal with the cost-centre issues
 155
 156 cgLetNoEscapeClosure
 157         binder cc binder_info srt full_live_in_rhss
 158         rhs_eob_info cc_slot rec args body
 159   = let
 160         arity   = length args
 161         lf_info = mkLFLetNoEscape arity
 162         uniq    = idUnique binder
 163         lbl     = mkReturnPtLabel uniq
 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 lbl)
 177                                                 `thenFC` \ code ->
 178          getSRTLabel                            `thenFC` \ srt_label ->
 179          absC (CRetDirect uniq code (srt_label,srt) 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                   -> CLabel     -- Entry label
 192                   -> Code
 193
 194 cgLetNoEscapeBody binder cc all_args body lbl
 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) = splitAt (length 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 frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
 225      in
 226
 227         -- Do heap check [ToDo: omit for non-recursive case by recording in
 228         --      in envt and absorbing at call site]
 229      altHeapCheck False arg_regs stk_tags frame_hdr_asst (Just lbl) (
 230         cgExpr body
 231      )
 232
 233 \end{code}