CgExpr.lhs 12.4 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
%
%********************************************************
%*							*
\section[CgExpr]{Converting @StgExpr@s}
%*							*
%********************************************************

\begin{code}
#include "HsVersions.h"

13
module CgExpr ( cgExpr, getPrimOpArgAmodes ) where
14

15
16
IMP_Ubiq(){-uitous-}
IMPORT_DELOOPER(CgLoop2)	-- here for paranoia-checking
17
18
19
20
21

import StgSyn
import CgMonad
import AbsCSyn

22
import AbsCUtils	( mkAbsCStmts, mkAbstractCs )
23
import CgBindery	( getArgAmodes, CgIdInfo )
24
25
26
27
28
import CgCase		( cgCase, saveVolatileVarsAndRegs )
import CgClosure	( cgRhsClosure )
import CgCon		( buildDynCon, cgReturnDataCon )
import CgHeapery	( allocHeap )
import CgLetNoEscape	( cgLetNoEscapeClosure )
29
30
31
32
33
34
35
36
37
import CgRetConv	( dataReturnConvAlg, ctrlReturnConvAlg,
			  DataReturnConvention(..), CtrlReturnConvention(..),
			  assignPrimOpResultRegs, makePrimOpArgsRobust
			)
import CgTailCall	( cgTailCall, performReturn,
			  mkDynamicAlgReturnCode, mkPrimReturnCode
			)
import CLabel		( mkPhantomInfoTableLabel, mkInfoTableVecTblLabel )
import ClosureInfo	( mkClosureLFInfo )
38
39
import CostCentre	( sccAbleCostCentre, isDictCC, isSccCountCostCentre )
import HeapOffs		( SYN_IE(VirtualSpBOffset) )
40
41
42
43
import Id		( mkIdSet, unionIdSets, GenId{-instance Outputable-} )
import PprStyle		( PprStyle(..) )
import PrimOp		( primOpCanTriggerGC, primOpHeapReq, HeapRequirement(..),
			  getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
44
			)
45
46
import PrimRep		( getPrimRepSize, PrimRep(..) )
import TyCon		( tyConDataCons )
47
import Util		( panic, pprPanic, assertPanic )
48
49
50
51
52
53
54
\end{code}

This module provides the support code for @StgToAbstractC@ to deal
with STG {\em expressions}.  See also @CgClosure@, which deals
with closures, and @CgCon@, which deals with constructors.

\begin{code}
55
cgExpr	:: StgExpr		-- input
56
57
58
59
60
61
62
63
64
65
66
	-> Code			-- output
\end{code}

%********************************************************
%*							*
%*		Tail calls				*
%*							*
%********************************************************

``Applications'' mean {\em tail calls}, a service provided by module
@CgTailCall@.  This includes literals, which show up as
67
@(STGApp (StgLitArg 42) [])@.
68
69
70
71
72
73
74
75
76
77
78
79

\begin{code}
cgExpr (StgApp fun args live_vars) = cgTailCall fun args live_vars
\end{code}

%********************************************************
%*							*
%*		STG ConApps  (for inline versions)	*
%*							*
%********************************************************

\begin{code}
80
cgExpr (StgCon con args live_vars)
81
  = getArgAmodes args `thenFC` \ amodes ->
82
83
    cgReturnDataCon con amodes (all zero_size args) live_vars
  where
84
    zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
85
86
87
88
89
90
91
92
93
94
95
\end{code}

%********************************************************
%*							*
%*		STG PrimApps  (unboxed primitive ops)	*
%*							*
%********************************************************

Here is where we insert real live machine instructions.

\begin{code}
96
cgExpr x@(StgPrim op args live_vars)
97
98
  = ASSERT(op /= SeqOp) -- can't handle SeqOp
    getPrimOpArgAmodes op args	`thenFC` \ arg_amodes ->
99
    let
100
	result_regs   = assignPrimOpResultRegs op
101
102
103
104
105
106
107
108
109
110
	result_amodes = map CReg result_regs
	may_gc  = primOpCanTriggerGC op
	dyn_tag = head result_amodes
	    -- The tag from a primitive op returning an algebraic data type
	    -- is returned in the first result_reg_amode
    in
    (if may_gc then
	-- Use registers for args, and assign args to the regs
	-- (Can-trigger-gc primops guarantee to have their args in regs)
	let
111
	    (arg_robust_amodes, liveness_mask, arg_assts)
112
	      = makePrimOpArgsRobust op arg_amodes
113
114
115
116
117

	    liveness_arg = mkIntCLit liveness_mask
	in
 	returnFC (
	    arg_assts,
118
119
120
121
	    COpStmt result_amodes op
		    (pin_liveness op liveness_arg arg_robust_amodes)
		    liveness_mask
		    [{-no vol_regs-}]
122
123
124
125
126
127
128
129
	)
     else
	-- Use args from their current amodes.
	let
	  liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
	in
 	returnFC (
	    COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
130
	    AbsCNop
131
132
133
134
135
136
137
138
	)
    )				`thenFC` \ (do_before_stack_cleanup,
					     do_just_before_jump) ->

    case (getPrimOpResultInfo op) of

	ReturnsPrim kind ->
	    performReturn do_before_stack_cleanup
139
    	    	    	  (\ sequel -> robustifySequel may_gc sequel
140
141
142
143
144
145
146
							`thenFC` \ (ret_asst, sequel') ->
			   absC (ret_asst `mkAbsCStmts` do_just_before_jump)
							`thenC`
			   mkPrimReturnCode sequel')
			  live_vars

	ReturnsAlg tycon ->
147
	    profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields]	`thenC`
148
149
150
151

	    performReturn do_before_stack_cleanup
			  (\ sequel -> robustifySequel may_gc sequel
						    	`thenFC` \ (ret_asst, sequel') ->
152
153
			   absC (mkAbstractCs [ret_asst,
					       do_just_before_jump,
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
					       info_ptr_assign])
			-- Must load info ptr here, not in do_just_before_stack_cleanup,
			-- because the info-ptr reg clashes with argument registers
			-- for the primop
								`thenC`
				      mkDynamicAlgReturnCode tycon dyn_tag sequel')
			  live_vars
	    where

	    -- Here, the destination _can_ be an update frame, so we need to make sure that
	    -- infoptr (R2) is loaded with the constructor's info ptr.

		info_ptr_assign = CAssign (CReg infoptr) info_lbl

		info_lbl
169
170
		  = case (ctrlReturnConvAlg tycon) of
		      VectoredReturn   _ -> vec_lbl
171
172
		      UnvectoredReturn _ -> dir_lbl

173
174
		vec_lbl  = CTableEntry (CLbl (mkInfoTableVecTblLabel tycon) DataPtrRep)
    	    	    	        dyn_tag DataPtrRep
175

176
		data_con = head (tyConDataCons tycon)
177
178

		(dir_lbl, num_of_fields)
179
		  = case (dataReturnConvAlg data_con) of
180
		      ReturnInRegs rs
181
			-> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrRep,
182
183
184
185
186
187
			    mkIntCLit (length rs)) -- for ticky-ticky only

    	    	      ReturnInHeap
			-> pprPanic "CgExpr: can't return prim in heap:" (ppr PprDebug data_con)
			  -- Never used, and no point in generating
			  -- the code for it!
188
189
190
191
192
193
194
195
196
197
198
199
200
  where
    -- for all PrimOps except ccalls, we pin the liveness info
    -- on as the first "argument"
    -- ToDo: un-duplicate?

    pin_liveness (CCallOp _ _ _ _ _) _ args = args
    pin_liveness other_op liveness_arg args
      = liveness_arg :args

    -- We only need to worry about the sequel when we may GC and the
    -- sequel is OnStack.  If that's the case, arrange to pull the
    -- sequel out into RetReg before performing the primOp.

201
    robustifySequel True sequel@(OnStack _) =
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
235
236
237
238
239
240
241
242
243
244
245
246
	sequelToAmode sequel			`thenFC` \ amode ->
	returnFC (CAssign (CReg RetReg) amode, InRetReg)
    robustifySequel _ sequel = returnFC (AbsCNop, sequel)
\end{code}

%********************************************************
%*							*
%*		Case expressions			*
%*							*
%********************************************************
Case-expression conversion is complicated enough to have its own
module, @CgCase@.
\begin{code}

cgExpr (StgCase expr live_vars save_vars uniq alts)
  = cgCase expr live_vars save_vars uniq alts
\end{code}


%********************************************************
%*							*
%* 		Let and letrec				*
%*							*
%********************************************************
\subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}

\begin{code}
cgExpr (StgLet (StgNonRec name rhs) expr)
  = cgRhs name rhs	`thenFC` \ (name, info) ->
    addBindC name info 	`thenC`
    cgExpr expr

cgExpr (StgLet (StgRec pairs) expr)
  = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
			    listFCs [ cgRhs b e | (b,e) <- pairs ]
    ) `thenFC` \ new_bindings ->

    addBindsC new_bindings `thenC`
    cgExpr expr
\end{code}

\begin{code}
cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
  =    	-- Figure out what volatile variables to save
    nukeDeadBindings live_in_whole_let	`thenC`
247
    saveVolatileVarsAndRegs live_in_rhss
248
249
250
251
    	    `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->

	-- ToDo: cost centre???

252
	-- Save those variables right now!
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
    absC save_assts				`thenC`

	-- Produce code for the rhss
	-- and add suitable bindings to the environment
    cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`

	-- Do the body
    setEndOfBlockInfo rhs_eob_info (cgExpr body)
\end{code}


%********************************************************
%*							*
%*		SCC Expressions				*
%*							*
%********************************************************
\subsection[scc-codegen]{Converting StgSCC}

SCC expressions are treated specially. They set the current cost
centre.
\begin{code}
274
275
276
277
278
279
280
cgExpr (StgSCC ty cc expr)
  = ASSERT(sccAbleCostCentre cc)
    costCentresC
	(if isDictCC cc then SLIT("SET_DICT_CCC") else SLIT("SET_CCC"))
	[mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)]
    `thenC`
    cgExpr expr
281
282
\end{code}

283
ToDo: counting of dict sccs ...
284
285
286
287
288
289
290
291
292

%********************************************************
%*							*
%*		Non-top-level bindings			*
%*							*
%********************************************************
\subsection[non-top-level-bindings]{Converting non-top-level bindings}

@cgBinding@ is only used for let/letrec, not for unboxed bindings.
293
So the kind should always be @PtrRep@.
294
295
296
297
298

We rely on the support code in @CgCon@ (to do constructors) and
in @CgClosure@ (to do closures).

\begin{code}
299
cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
300
301
302
	-- the Id is passed along so a binding can be set up

cgRhs name (StgRhsCon maybe_cc con args)
303
  = getArgAmodes args		`thenFC` \ amodes ->
304
305
306
307
    buildDynCon name maybe_cc con amodes (all zero_size args)
				`thenFC` \ idinfo ->
    returnFC (name, idinfo)
  where
308
    zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
309
310
311
312
313
314
315
316
317

cgRhs name (StgRhsClosure cc bi fvs upd_flag args body)
  = cgRhsClosure name cc bi fvs args body lf_info
  where
    lf_info = mkClosureLFInfo False{-not top level-} fvs upd_flag args body
\end{code}

\begin{code}
cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
318
  = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot binder rhs
319
320
321
322
323
324
    	    	    	    	`thenFC` \ (binder, info) ->
    addBindC binder info

cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
  = fixC (\ new_bindings ->
		addBindsC new_bindings 	`thenC`
325
326
		listFCs [ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info
			  maybe_cc_slot b e | (b,e) <- pairs ]
327
328
329
330
331
332
    ) `thenFC` \ new_bindings ->

    addBindsC new_bindings
  where
    -- We add the binders to the live-in-rhss set so that we don't
    -- delete the bindings for the binder from the environment!
333
    full_live_in_rhss = live_in_rhss `unionIdSets` (mkIdSet [b | (b,r) <- pairs])
334

335
336
337
cgLetNoEscapeRhs
    :: StgLiveVars	-- Live in rhss
    -> EndOfBlockInfo
338
339
    -> Maybe VirtualSpBOffset
    -> Id
340
    -> StgRhs
341
342
343
344
345
346
347
348
349
350
351
    -> FCode (Id, CgIdInfo)

cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
		 (StgRhsClosure cc bi _ upd_flag args body)
  = -- We could check the update flag, but currently we don't switch it off
    -- for let-no-escaped things, so we omit the check too!
    -- case upd_flag of
    --     Updatable -> panic "cgLetNoEscapeRhs"	-- Nothing to update!
    --     other     -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
    cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot args body

352
-- For a constructor RHS we want to generate a single chunk of code which
353
354
355
356
357
358
-- can be jumped to from many places, which will return the constructor.
-- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
    	    	 (StgRhsCon cc con args)
  = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} full_live_in_rhss rhs_eob_info maybe_cc_slot
	[] 	--No args; the binder is data structure, not a function
359
	(StgCon con args full_live_in_rhss)
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
\end{code}

Some PrimOps require a {\em fixed} amount of heap allocation.  Rather
than tidy away ready for GC and do a full heap check, we simply
allocate a completely uninitialised block in-line, just like any other
thunk/constructor allocation, and pass it to the PrimOp as its first
argument.  Remember! The PrimOp is entirely responsible for
initialising the object.  In particular, the PrimOp had better not
trigger GC before it has filled it in, and even then it had better
make sure that the GC can find the object somehow.

Main current use: allocating SynchVars.

\begin{code}
getPrimOpArgAmodes op args
375
  = getArgAmodes args		`thenFC` \ arg_amodes ->
376
377
378
379
380

    case primOpHeapReq op of
	FixedHeapRequired size -> allocHeap size `thenFC` \ amode ->
     	    	    	    	  returnFC (amode : arg_amodes)

381
	_   	    	       -> returnFC arg_amodes
382
383
384
\end{code}