summaryrefslogtreecommitdiff
path: root/ghc/compiler/codeGen/CgLetNoEscape.lhs
blob: 8562b678b0bc0cb3255fe337c39e7b9503ad11a0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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
105
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
% $Id: CgLetNoEscape.lhs,v 1.16 2001/10/25 02:13:11 sof Exp $
%
%********************************************************
%*							*
\section[CgLetNoEscape]{Handling ``let-no-escapes''}
%*							*
%********************************************************

\begin{code}
module CgLetNoEscape ( cgLetNoEscapeClosure ) where

#include "HsVersions.h"

import {-# SOURCE #-} CgExpr ( cgExpr )

import StgSyn
import CgMonad
import AbsCSyn

import CgBindery	( letNoEscapeIdInfo, bindArgsToRegs,
			  bindNewToStack, buildContLivenessMask, CgIdInfo,
			  nukeDeadBindings
			)
import CgHeapery	( altHeapCheck )
import CgRetConv	( assignRegs )
import CgStackery	( mkTaggedVirtStkOffsets, 
			  allocStackTop, deAllocStackTop, freeStackSlots )
import CgUsages		( setRealAndVirtualSp, getRealSp, getSpRelOffset )
import CLabel		( mkReturnInfoLabel )
import ClosureInfo	( mkLFLetNoEscape )
import CostCentre       ( CostCentreStack )
import Id		( idPrimRep, Id )
import Var		( idUnique )
import PrimRep		( PrimRep(..), retPrimRepSize )
import BasicTypes	( RecFlag(..) )
import Unique		( Unique )
import Util		( splitAtList )
\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
	in
	 	if ... then x else
		if ... then x else ...
\end{verbatim}
@x@ is used twice (so we probably can't unfold it), but when it is
entered, the stack is deeper than it was when the definition of @x@
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 ...
	in
		...(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
	-> CostCentreStack   	-- NB: *** NOT USED *** ToDo (WDP 94/06)
	-> StgBinderInfo	-- NB: ditto
	-> SRT
	-> StgLiveVars		-- variables live in RHS, including the binders
				-- themselves in the case of a recursive group
	-> EndOfBlockInfo       -- where are we going to?
	-> Maybe VirtualSpOffset -- Slot for current cost centre
	-> RecFlag		-- is the binding recursive?
	-> [Id]			-- args (as in \ args -> body)
    	-> StgExpr		-- body (as in above)
	-> FCode (Id, CgIdInfo)

-- ToDo: deal with the cost-centre issues

cgLetNoEscapeClosure 
	binder cc binder_info srt full_live_in_rhss 
	rhs_eob_info cc_slot rec args body
  = let
	arity   = length args
	lf_info = mkLFLetNoEscape arity
	uniq    = idUnique binder
    in

    -- saveVolatileVarsAndRegs done earlier in cgExpr.

    forkEvalHelp
	rhs_eob_info

	(allocStackTop retPrimRepSize	`thenFC` \_ ->
	 nukeDeadBindings full_live_in_rhss)

	(deAllocStackTop retPrimRepSize		`thenFC` \_ ->
	 buildContLivenessMask uniq		`thenFC` \ liveness ->
     	 forkAbsC (cgLetNoEscapeBody binder cc args body uniq) 
						`thenFC` \ code ->
	 getSRTInfo srt				`thenFC` \ srt_info -> 
	 absC (CRetDirect uniq code srt_info liveness)
		`thenC` returnFC ())
	    	    	    	     	`thenFC` \ (vSp, _) ->

    returnFC (binder, letNoEscapeIdInfo binder vSp lf_info)
\end{code}

\begin{code}
cgLetNoEscapeBody :: Id
		  -> CostCentreStack
		  -> [Id]	-- Args
		  -> StgExpr	-- Body
		  -> Unique     -- Unique for entry label
		  -> Code

cgLetNoEscapeBody binder cc all_args body uniq
   = 
     -- this is where the stack frame lives:
     getRealSp   `thenFC` \sp -> 

     let
	arg_kinds	     = map idPrimRep all_args
	(arg_regs, _)	     = assignRegs [{-nothing live-}] arg_kinds
	(reg_args, stk_args) = splitAtList arg_regs all_args

    	(sp_stk_args, stk_offsets, stk_tags)
	  = mkTaggedVirtStkOffsets sp idPrimRep stk_args
     in

	-- Bind args to appropriate regs/stk locns
     bindArgsToRegs reg_args arg_regs		    `thenC`
     mapCs bindNewToStack stk_offsets		    `thenC`
     setRealAndVirtualSp sp_stk_args		    `thenC`

	-- free up the stack slots containing tags, and the slot
	-- containing the return address (really frame header).
 	-- c.f. CgCase.cgUnboxedTupleAlt.
     freeStackSlots (sp : map fst stk_tags)	    `thenC`

	-- Enter the closures cc, if required
     --enterCostCentreCode closure_info cc IsFunction  `thenC`

 	-- fill in the frame header only if we fail a heap check:
	-- otherwise it isn't needed.
     getSpRelOffset sp			`thenFC` \sp_rel ->
     let lbl = mkReturnInfoLabel uniq
	 frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
     in

	-- Do heap check [ToDo: omit for non-recursive case by recording in
	--	in envt and absorbing at call site]
     altHeapCheck False arg_regs stk_tags frame_hdr_asst (Just uniq) (
	cgExpr body
     )

\end{code}