profiling fixes
[ghc.git] / compiler / codeGen / CgLetNoEscape.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 %
5 %********************************************************
6 %*                                                      *
7 \section[CgLetNoEscape]{Handling ``let-no-escapes''}
8 %*                                                      *
9 %********************************************************
10
11 \begin{code}
12 {-# OPTIONS -fno-warn-tabs #-}
13 -- The above warning supression flag is a temporary kludge.
14 -- While working on this module you are encouraged to remove it and
15 -- detab the module (please do the detabbing in a separate patch). See
16 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
17 -- for details
18
19 module CgLetNoEscape ( cgLetNoEscapeClosure ) where
20
21 #include "HsVersions.h"
22
23 import {-# SOURCE #-} CgExpr ( cgExpr )
24
25 import StgSyn
26 import CgMonad
27
28 import CgBindery
29 import CgCase
30 import CgCon
31 import CgHeapery
32 import CgInfoTbls
33 import CgStackery
34 import OldCmm
35 import OldCmmUtils
36 import CLabel
37 import ClosureInfo
38 import CostCentre
39 import Id
40 import BasicTypes
41 \end{code}
42
43 %************************************************************************
44 %*                                                                      *
45 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
46 %*                                                                      *
47 %************************************************************************
48
49 [The {\em code} that detects these things is elsewhere.]
50
51 Consider:
52 \begin{verbatim}
53         let x = fvs \ args -> e
54         in
55                 if ... then x else
56                 if ... then x else ...
57 \end{verbatim}
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
64 to the code for @x@.
65
66 All of this is provided x is:
67 \begin{enumerate}
68 \item
69 non-updatable;
70 \item
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;
73 \item
74 all the enters have exactly the right number of arguments,
75 no more no less;
76 \item
77 all the enters are tail calls; that is, they return to the
78 caller enclosing the definition of @x@.
79 \end{enumerate}
80
81 Under these circumstances we say that @x@ is {\em non-escaping}.
82
83 An example of when (4) does {\em not} hold:
84 \begin{verbatim}
85         let x = ...
86         in case x of ...alts...
87 \end{verbatim}
88
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.
93
94 Things can get a little more complicated.  Consider:
95 \begin{verbatim}
96         let y = ...
97         in let x = fvs \ args -> ...y...
98         in ...x...
99 \end{verbatim}
100
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
103 non-escaping.
104
105 @x@ can even be recursive!  Eg:
106 \begin{verbatim}
107         letrec x = [y] \ [v] -> if v then x True else ...
108         in
109                 ...(x b)...
110 \end{verbatim}
111
112
113 %************************************************************************
114 %*                                                                      *
115 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
116 %*                                                                      *
117 %************************************************************************
118
119
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
122 \begin{verbatim}
123         let-no-escape x = b
124         in e
125 \end{verbatim}
126 and
127 \begin{verbatim}
128         case e of ... -> b
129 \end{verbatim}
130
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.
136
137 First, we need to save all @x@'s free vars
138 on the stack, if they aren't there already.
139
140 \begin{code}
141 cgLetNoEscapeClosure
142         :: Id                   -- binder
143         -> CostCentreStack      -- NB: *** NOT USED *** ToDo (WDP 94/06)
144         -> 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)
153
154 -- ToDo: deal with the cost-centre issues
155
156 cgLetNoEscapeClosure 
157         bndr cc _ full_live_in_rhss 
158         rhs_eob_info cc_slot _ args body
159   = let
160         arity   = length args
161         lf_info = mkLFLetNoEscape arity
162     in
163     -- saveVolatileVarsAndRegs done earlier in cgExpr.
164
165     do  { dflags <- getDynFlags
166         ; (vSp, _) <- forkEvalHelp rhs_eob_info
167
168                 (do { allocStackTop retAddrSizeW
169                     ; nukeDeadBindings full_live_in_rhss })
170
171                 (do { deAllocStackTop retAddrSizeW
172                     ; abs_c <- forkProc $ cgLetNoEscapeBody bndr cc 
173                                                   cc_slot args body
174
175                         -- Ignore the label that comes back from
176                         -- mkRetDirectTarget.  It must be conjured up elswhere
177                     ; _ <- emitReturnTarget (idName bndr) abs_c
178                     ; return () })
179
180         ; returnFC (bndr, letNoEscapeIdInfo dflags bndr vSp lf_info) }
181 \end{code}
182
183 \begin{code}
184 cgLetNoEscapeBody :: Id         -- Name of the joint point
185                   -> CostCentreStack
186                   -> Maybe VirtualSpOffset
187                   -> [Id]       -- Args
188                   -> StgExpr    -- Body
189                   -> Code
190
191 cgLetNoEscapeBody bndr _ cc_slot all_args body = do
192   { (arg_regs, ptrs, nptrs, ret_slot) <- bindUnboxedTupleComponents all_args
193
194      -- restore the saved cost centre.  BUT: we must not free the stack slot
195      -- containing the cost centre, because it might be needed for a
196      -- recursive call to this let-no-escape.
197   ; restoreCurrentCostCentre cc_slot False{-don't free-}
198
199         -- Enter the closures cc, if required
200   ; -- enterCostCentreCode closure_info cc IsFunction
201
202         -- The "return address" slot doesn't have a return address in it;
203         -- but the heap-check needs it filled in if the heap-check fails.
204         -- So we pass code to fill it in to the heap-check macro
205   ; sp_rel <- getSpRelOffset ret_slot
206
207   ; let lbl            = mkReturnInfoLabel (idUnique bndr)
208         frame_hdr_asst = oneStmt (CmmStore sp_rel (mkLblExpr lbl))
209
210         -- Do heap check [ToDo: omit for non-recursive case by recording in
211         --      in envt and absorbing at call site]
212   ; unbxTupleHeapCheck arg_regs ptrs nptrs frame_hdr_asst 
213                         (cgExpr body)
214   }
215 \end{code}