2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 % $Id: CgLetNoEscape.lhs,v 1.18 2002/09/13 15:02:28 simonpj Exp $
6 %********************************************************
8 \section[CgLetNoEscape]{Handling ``let-no-escapes''}
10 %********************************************************
13 module CgLetNoEscape ( cgLetNoEscapeClosure ) where
15 #include "HsVersions.h"
17 import {-# SOURCE #-} CgExpr ( cgExpr )
23 import CgBindery ( letNoEscapeIdInfo, bindArgsToRegs,
24 bindNewToStack, buildContLivenessMask, CgIdInfo,
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 )
43 %************************************************************************
45 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
47 %************************************************************************
49 [The {\em code} that detects these things is elsewhere.]
53 let x = fvs \ args -> e
56 if ... then x else ...
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
66 All of this is provided x is:
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;
74 all the enters have exactly the right number of arguments,
77 all the enters are tail calls; that is, they return to the
78 caller enclosing the definition of @x@.
81 Under these circumstances we say that @x@ is {\em non-escaping}.
83 An example of when (4) does {\em not} hold:
86 in case x of ...alts...
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.
94 Things can get a little more complicated. Consider:
97 in let x = fvs \ args -> ...y...
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
105 @x@ can even be recursive! Eg:
107 letrec x = [y] \ [v] -> if v then x True else ...
113 %************************************************************************
115 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
117 %************************************************************************
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
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.
137 First, we need to save all @x@'s free vars
138 on the stack, if they aren't there already.
143 -> CostCentreStack -- NB: *** NOT USED *** ToDo (WDP 94/06)
144 -> StgBinderInfo -- NB: ditto
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)
155 -- ToDo: deal with the cost-centre issues
158 binder cc binder_info srt full_live_in_rhss
159 rhs_eob_info cc_slot rec args body
162 lf_info = mkLFLetNoEscape arity
163 uniq = idUnique binder
166 -- saveVolatileVarsAndRegs done earlier in cgExpr.
171 (allocStackTop retPrimRepSize `thenFC` \_ ->
172 nukeDeadBindings full_live_in_rhss)
174 (deAllocStackTop retPrimRepSize `thenFC` \_ ->
175 buildContLivenessMask uniq `thenFC` \ liveness ->
176 forkAbsC (cgLetNoEscapeBody binder cc args body uniq)
178 getSRTInfo srt `thenFC` \ srt_info ->
179 absC (CRetDirect uniq code srt_info liveness)
181 `thenFC` \ (vSp, _) ->
183 returnFC (binder, letNoEscapeIdInfo binder vSp lf_info)
187 cgLetNoEscapeBody :: Id
191 -> Unique -- Unique for entry label
194 cgLetNoEscapeBody binder cc all_args body uniq
196 -- this is where the stack frame lives:
197 getRealSp `thenFC` \sp ->
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
204 (sp_stk_args, stk_offsets, stk_tags)
205 = mkTaggedVirtStkOffsets sp idPrimRep stk_args
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`
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`
218 -- Enter the closures cc, if required
219 --enterCostCentreCode closure_info cc IsFunction `thenC`
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)
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) (