CgLetNoEscape.lhs 6.52 KB
 partain committed Jan 08, 1996 1 %  simonm committed Dec 02, 1998 2 3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 %  simonpj committed Sep 30, 2004 4 % $Id: CgLetNoEscape.lhs,v 1.26 2004/09/30 10:35:47 simonpj Exp$  partain committed Jan 08, 1996 5 6 7 8 9 10 11 12 13 14 % %******************************************************** %* * \section[CgLetNoEscape]{Handling let-no-escapes''} %* * %******************************************************** \begin{code} module CgLetNoEscape ( cgLetNoEscapeClosure ) where  simonm committed Jan 08, 1998 15 16 #include "HsVersions.h"  sof committed Jun 05, 1997 17 import {-# SOURCE #-} CgExpr ( cgExpr )  partain committed Apr 05, 1996 18   partain committed Jan 08, 1996 19 20 21 import StgSyn import CgMonad  simonpj committed Jul 02, 2003 22 import CgBindery ( CgIdInfo, letNoEscapeIdInfo, nukeDeadBindings )  simonmar committed Aug 13, 2004 23 import CgCase ( restoreCurrentCostCentre )  simonpj committed Jul 02, 2003 24 import CgCon ( bindUnboxedTupleComponents )  simonmar committed Dec 11, 2002 25 import CgHeapery ( unbxTupleHeapCheck )  simonmar committed Aug 13, 2004 26 27 28 29 import CgInfoTbls ( emitDirectReturnTarget ) import CgStackery ( allocStackTop, deAllocStackTop, getSpRelOffset ) import Cmm ( CmmStmt(..) ) import CmmUtils ( mkLblExpr, oneStmt )  simonm committed May 13, 1999 30 import CLabel ( mkReturnInfoLabel )  partain committed Jan 08, 1996 31 import ClosureInfo ( mkLFLetNoEscape )  simonm committed Dec 02, 1998 32 import CostCentre ( CostCentreStack )  simonmar committed Aug 13, 2004 33 import Id ( Id, idName )  simonm committed Dec 02, 1998 34 import Var ( idUnique )  simonmar committed Aug 13, 2004 35 import SMRep ( retAddrSizeW )  simonm committed Dec 02, 1998 36 import BasicTypes ( RecFlag(..) )  simonmar committed Aug 13, 2004 37 import Outputable  partain committed Jan 08, 1996 38 39 40 41 42 43 44 45 46 47 48 49 50 \end{code} %************************************************************************ %* * \subsection[what-is-non-escaping]{What {\em is} a non-escaping let''?} %* * %************************************************************************ [The {\em code} that detects these things is elsewhere.] Consider: \begin{verbatim} let x = fvs \ args -> e  partain committed Mar 19, 1996 51 52  in if ... then x else  partain committed Jan 08, 1996 53 54 55  if ... then x else ... \end{verbatim} @x@ is used twice (so we probably can't unfold it), but when it is  simonm committed Dec 02, 1998 56 entered, the stack is deeper than it was when the definition of @x@  partain committed Jan 08, 1996 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 happened. Specifically, if instead of allocating a closure for @x@, we saved all @x@'s fvs on the stack, and remembered the stack depth at that moment, then whenever we enter @x@ we can simply set the stack pointer(s) to these remembered (compile-time-fixed) values, and jump to the code for @x@. All of this is provided x is: \begin{enumerate} \item non-updatable; \item guaranteed to be entered before the stack retreats -- ie x is not buried in a heap-allocated closure, or passed as an argument to something; \item all the enters have exactly the right number of arguments, no more no less; \item all the enters are tail calls; that is, they return to the caller enclosing the definition of @x@. \end{enumerate} Under these circumstances we say that @x@ is {\em non-escaping}. An example of when (4) does {\em not} hold: \begin{verbatim} let x = ... in case x of ...alts... \end{verbatim} Here, @x@ is certainly entered only when the stack is deeper than when @x@ is defined, but here it must return to \tr{...alts...} So we can't just adjust the stack down to @x@'s recalled points, because that would lost @alts@' context. Things can get a little more complicated. Consider: \begin{verbatim} let y = ... in let x = fvs \ args -> ...y... in ...x... \end{verbatim} Now, if @x@ is used in a non-escaping way in \tr{...x...}, {\em and} @y@ is used in a non-escaping way in \tr{...y...}, {\em then} @y@ is non-escaping. @x@ can even be recursive! Eg: \begin{verbatim} letrec x = [y] \ [v] -> if v then x True else ...  partain committed Mar 19, 1996 105  in  partain committed Jan 08, 1996 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139  ...(x b)... \end{verbatim} %************************************************************************ %* * \subsection[codeGen-for-non-escaping]{Generating code for a non-escaping let''} %* * %************************************************************************ Generating code for this is fun. It is all very very similar to what we do for a case expression. The duality is between \begin{verbatim} let-no-escape x = b in e \end{verbatim} and \begin{verbatim} case e of ... -> b \end{verbatim} That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like the alternative of the case; it needs to be compiled in an environment in which all volatile bindings are forgotten, and the free vars are bound only to stable things like stack locations.. The @e@ part will execute {\em next}, just like the scrutinee of a case. First, we need to save all @x@'s free vars on the stack, if they aren't there already. \begin{code} cgLetNoEscapeClosure :: Id -- binder  simonm committed Dec 02, 1998 140  -> CostCentreStack -- NB: *** NOT USED *** ToDo (WDP 94/06)  partain committed Jan 08, 1996 141  -> StgBinderInfo -- NB: ditto  simonm committed Dec 02, 1998 142 143  -> SRT -> StgLiveVars -- variables live in RHS, including the binders  partain committed Jan 08, 1996 144  -- themselves in the case of a recursive group  partain committed Mar 19, 1996 145  -> EndOfBlockInfo -- where are we going to?  simonm committed Dec 02, 1998 146 147  -> Maybe VirtualSpOffset -- Slot for current cost centre -> RecFlag -- is the binding recursive?  partain committed Jan 08, 1996 148  -> [Id] -- args (as in \ args -> body)  partain committed Mar 19, 1996 149  -> StgExpr -- body (as in above)  partain committed Jan 08, 1996 150 151 152 153  -> FCode (Id, CgIdInfo) -- ToDo: deal with the cost-centre issues  simonm committed Dec 02, 1998 154 cgLetNoEscapeClosure  simonpj committed Jul 02, 2003 155  bndr cc binder_info srt full_live_in_rhss  simonm committed Dec 02, 1998 156  rhs_eob_info cc_slot rec args body  partain committed Jan 08, 1996 157 158  = let arity = length args  simonm committed Dec 02, 1998 159  lf_info = mkLFLetNoEscape arity  partain committed Jan 08, 1996 160  in  simonm committed Dec 02, 1998 161 162  -- saveVolatileVarsAndRegs done earlier in cgExpr.  simonmar committed Aug 13, 2004 163 164 165 166  do { (vSp, _) <- forkEvalHelp rhs_eob_info (do { allocStackTop retAddrSizeW ; nukeDeadBindings full_live_in_rhss })  simonm committed Dec 02, 1998 167   simonmar committed Aug 13, 2004 168 169 170  (do { deAllocStackTop retAddrSizeW ; abs_c <- forkProc \$ cgLetNoEscapeBody bndr cc cc_slot args body  simonm committed Dec 02, 1998 171   simonmar committed Aug 13, 2004 172 173 174 175  -- Ignore the label that comes back from -- mkRetDirectTarget. It must be conjured up elswhere ; emitDirectReturnTarget (idName bndr) abs_c srt ; return () })  simonpj committed Jul 02, 2003 176   simonmar committed Aug 13, 2004 177  ; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) }  partain committed Jan 08, 1996 178 179 180 \end{code} \begin{code}  simonpj committed Jul 02, 2003 181 cgLetNoEscapeBody :: Id -- Name of the joint point  simonm committed Dec 02, 1998 182  -> CostCentreStack  simonmar committed Jul 18, 2003 183  -> Maybe VirtualSpOffset  simonm committed Dec 02, 1998 184  -> [Id] -- Args  partain committed Mar 19, 1996 185  -> StgExpr -- Body  partain committed Jan 08, 1996 186 187  -> Code  simonmar committed Aug 13, 2004 188 189 cgLetNoEscapeBody bndr cc cc_slot all_args body = do { (arg_regs, ptrs, nptrs, ret_slot) <- bindUnboxedTupleComponents all_args  partain committed Jan 08, 1996 190   simonmar committed Jul 21, 2003 191 192 193  -- restore the saved cost centre. BUT: we must not free the stack slot -- containing the cost centre, because it might be needed for a -- recursive call to this let-no-escape.  simonmar committed Aug 13, 2004 194  ; restoreCurrentCostCentre cc_slot False{-don't free-}  simonmar committed Jul 18, 2003 195   partain committed Jan 08, 1996 196  -- Enter the closures cc, if required  simonmar committed Aug 13, 2004 197  ; -- enterCostCentreCode closure_info cc IsFunction  partain committed Jan 08, 1996 198   simonpj committed Jul 02, 2003 199 200 201  -- The "return address" slot doesn't have a return address in it; -- but the heap-check needs it filled in if the heap-check fails. -- So we pass code to fill it in to the heap-check macro  simonmar committed Aug 13, 2004 202 203 204 205  ; sp_rel <- getSpRelOffset ret_slot ; let lbl = mkReturnInfoLabel (idUnique bndr) frame_hdr_asst = oneStmt (CmmStore sp_rel (mkLblExpr lbl))  partain committed Jan 08, 1996 206 207 208  -- Do heap check [ToDo: omit for non-recursive case by recording in -- in envt and absorbing at call site]  simonmar committed Aug 13, 2004 209 210 211  ; unbxTupleHeapCheck arg_regs ptrs nptrs frame_hdr_asst (cgExpr body) }  partain committed Jan 08, 1996 212 \end{code}