2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 % $Id: CgLetNoEscape.lhs,v 1.20 2003/05/14 09:13:56 simonmar 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 ( 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 )
43 import List ( partition )
46 %************************************************************************
48 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
50 %************************************************************************
52 [The {\em code} that detects these things is elsewhere.]
56 let x = fvs \ args -> e
59 if ... then x else ...
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
69 All of this is provided x is:
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;
77 all the enters have exactly the right number of arguments,
80 all the enters are tail calls; that is, they return to the
81 caller enclosing the definition of @x@.
84 Under these circumstances we say that @x@ is {\em non-escaping}.
86 An example of when (4) does {\em not} hold:
89 in case x of ...alts...
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.
97 Things can get a little more complicated. Consider:
100 in let x = fvs \ args -> ...y...
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
108 @x@ can even be recursive! Eg:
110 letrec x = [y] \ [v] -> if v then x True else ...
116 %************************************************************************
118 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
120 %************************************************************************
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
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.
140 First, we need to save all @x@'s free vars
141 on the stack, if they aren't there already.
146 -> CostCentreStack -- NB: *** NOT USED *** ToDo (WDP 94/06)
147 -> StgBinderInfo -- NB: ditto
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)
158 -- ToDo: deal with the cost-centre issues
161 binder cc binder_info srt full_live_in_rhss
162 rhs_eob_info cc_slot rec args body
165 lf_info = mkLFLetNoEscape arity
166 uniq = idUnique binder
169 -- saveVolatileVarsAndRegs done earlier in cgExpr.
174 (allocStackTop retPrimRepSize `thenFC` \_ ->
175 nukeDeadBindings full_live_in_rhss)
177 (deAllocStackTop retPrimRepSize `thenFC` \_ ->
178 buildContLivenessMask (getName binder) `thenFC` \ liveness ->
179 forkAbsC (cgLetNoEscapeBody binder cc args body uniq)
181 getSRTInfo (idName binder) srt `thenFC` \ srt_info ->
182 absC (CRetDirect uniq code srt_info liveness)
184 `thenFC` \ (vSp, _) ->
186 returnFC (binder, letNoEscapeIdInfo binder vSp lf_info)
190 cgLetNoEscapeBody :: Id
194 -> Unique -- Unique for entry label
197 cgLetNoEscapeBody binder cc all_args body uniq
199 -- this is where the stack frame lives:
200 getRealSp `thenFC` \sp ->
202 -- This is very much like bindUnboxedTupleComponents (ToDo)
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
208 -- separate the rest of the args into pointers and non-pointers
209 ( ptr_args, nptr_args ) =
210 partition (isFollowableRep . idPrimRep) stk_args
212 (ptr_sp, ptr_offsets) = mkVirtStkOffsets sp idPrimRep ptr_args
213 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp idPrimRep nptr_args
216 nptrs = nptr_sp - ptr_sp
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`
224 setRealAndVirtualSp nptr_sp `thenC`
226 -- free up the stack slots containing the return address
227 -- (frame header itbl). c.f. CgCase.cgUnboxedTupleAlt.
228 freeStackSlots [sp] `thenC`
230 -- Enter the closures cc, if required
231 --enterCostCentreCode closure_info cc IsFunction `thenC`
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)
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 (