2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 % $Id: CgLetNoEscape.lhs,v 1.14 2000/07/11 16:03:37 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 ( 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 Unique ( Unique )
39 import BasicTypes ( RecFlag(..) )
42 %************************************************************************
44 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
46 %************************************************************************
48 [The {\em code} that detects these things is elsewhere.]
52 let x = fvs \ args -> e
55 if ... then x else ...
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
65 All of this is provided x is:
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;
73 all the enters have exactly the right number of arguments,
76 all the enters are tail calls; that is, they return to the
77 caller enclosing the definition of @x@.
80 Under these circumstances we say that @x@ is {\em non-escaping}.
82 An example of when (4) does {\em not} hold:
85 in case x of ...alts...
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.
93 Things can get a little more complicated. Consider:
96 in let x = fvs \ args -> ...y...
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
104 @x@ can even be recursive! Eg:
106 letrec x = [y] \ [v] -> if v then x True else ...
112 %************************************************************************
114 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
116 %************************************************************************
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
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.
136 First, we need to save all @x@'s free vars
137 on the stack, if they aren't there already.
142 -> CostCentreStack -- NB: *** NOT USED *** ToDo (WDP 94/06)
143 -> StgBinderInfo -- NB: ditto
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)
154 -- ToDo: deal with the cost-centre issues
157 binder cc binder_info srt full_live_in_rhss
158 rhs_eob_info cc_slot rec args body
161 lf_info = mkLFLetNoEscape arity
162 uniq = idUnique binder
165 -- saveVolatileVarsAndRegs done earlier in cgExpr.
170 (allocStackTop retPrimRepSize `thenFC` \_ ->
171 nukeDeadBindings full_live_in_rhss)
173 (deAllocStackTop retPrimRepSize `thenFC` \_ ->
174 buildContLivenessMask uniq `thenFC` \ liveness ->
175 forkAbsC (cgLetNoEscapeBody binder cc args body uniq)
177 getSRTLabel `thenFC` \ srt_label ->
178 absC (CRetDirect uniq code (srt_label,srt) liveness)
180 `thenFC` \ (vSp, _) ->
182 returnFC (binder, letNoEscapeIdInfo binder vSp lf_info)
186 cgLetNoEscapeBody :: Id
190 -> Unique -- Unique for entry label
193 cgLetNoEscapeBody binder cc all_args body uniq
195 -- this is where the stack frame lives:
196 getRealSp `thenFC` \sp ->
199 arg_kinds = map idPrimRep all_args
200 (arg_regs, _) = assignRegs [{-nothing live-}] arg_kinds
201 (reg_args, stk_args) = splitAt (length arg_regs) all_args
203 (sp_stk_args, stk_offsets, stk_tags)
204 = mkTaggedVirtStkOffsets sp idPrimRep stk_args
207 -- Bind args to appropriate regs/stk locns
208 bindArgsToRegs reg_args arg_regs `thenC`
209 mapCs bindNewToStack stk_offsets `thenC`
210 setRealAndVirtualSp sp_stk_args `thenC`
212 -- free up the stack slots containing tags, and the slot
213 -- containing the return address (really frame header).
214 -- c.f. CgCase.cgUnboxedTupleAlt.
215 freeStackSlots (sp : map fst stk_tags) `thenC`
217 -- Enter the closures cc, if required
218 --enterCostCentreCode closure_info cc IsFunction `thenC`
220 -- fill in the frame header only if we fail a heap check:
221 -- otherwise it isn't needed.
222 getSpRelOffset sp `thenFC` \sp_rel ->
223 let lbl = mkReturnInfoLabel uniq
224 frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
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 uniq) (