2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 %********************************************************
6 \section[CgExpr]{Converting @StgExpr@s}
8 %********************************************************
11 module CgExpr ( cgExpr, getPrimOpArgAmodes ) where
13 #include "HsVersions.h"
15 import Constants ( mAX_SPEC_SELECTEE_SIZE )
20 import AbsCUtils ( mkAbsCStmts, mkAbstractCs )
21 import CgBindery ( getArgAmodes, getCAddrModeAndInfo, CgIdInfo )
22 import CgCase ( cgCase, saveVolatileVarsAndRegs )
23 import CgClosure ( cgRhsClosure )
24 import CgCon ( buildDynCon, cgReturnDataCon )
25 import CgHeapery ( allocHeap )
26 import CgLetNoEscape ( cgLetNoEscapeClosure )
27 import CgRetConv ( dataReturnConvAlg, ctrlReturnConvAlg,
28 DataReturnConvention(..), CtrlReturnConvention(..),
29 assignPrimOpResultRegs, makePrimOpArgsRobust
31 import CgTailCall ( cgTailCall, performReturn,
32 mkDynamicAlgReturnCode, mkPrimReturnCode
34 import CLabel ( mkPhantomInfoTableLabel, mkInfoTableVecTblLabel )
35 import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo, mkVapLFInfo,
37 import CostCentre ( sccAbleCostCentre, isDictCC, isSccCountCostCentre )
38 import HeapOffs ( VirtualSpBOffset, intOffsetIntoGoods )
39 import Id ( dataConTyCon, idPrimRep, getIdArity,
40 mkIdSet, unionIdSets, GenId{-instance Outputable-},
43 import IdInfo ( ArityInfo(..) )
44 import Name ( isLocallyDefined )
45 import PrimOp ( primOpCanTriggerGC, primOpHeapReq, HeapRequirement(..),
46 getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
48 import PrimRep ( getPrimRepSize, PrimRep(..) )
49 import TyCon ( tyConDataCons, maybeTyConSingleCon )
50 import Maybes ( assocMaybe, maybeToBool )
55 This module provides the support code for @StgToAbstractC@ to deal
56 with STG {\em expressions}. See also @CgClosure@, which deals
57 with closures, and @CgCon@, which deals with constructors.
60 cgExpr :: StgExpr -- input
64 %********************************************************
68 %********************************************************
70 ``Applications'' mean {\em tail calls}, a service provided by module
71 @CgTailCall@. This includes literals, which show up as
72 @(STGApp (StgLitArg 42) [])@.
75 cgExpr (StgApp fun args live_vars) = cgTailCall fun args live_vars
78 %********************************************************
80 %* STG ConApps (for inline versions) *
82 %********************************************************
85 cgExpr (StgCon con args live_vars)
86 = getArgAmodes args `thenFC` \ amodes ->
87 cgReturnDataCon con amodes (all zero_size args) live_vars
89 zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
92 %********************************************************
94 %* STG PrimApps (unboxed primitive ops) *
96 %********************************************************
98 Here is where we insert real live machine instructions.
101 cgExpr x@(StgPrim op args live_vars)
102 = ASSERT(op /= SeqOp) -- can't handle SeqOp
103 getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
105 result_regs = assignPrimOpResultRegs op
106 result_amodes = map CReg result_regs
107 may_gc = primOpCanTriggerGC op
108 dyn_tag = head result_amodes
109 -- The tag from a primitive op returning an algebraic data type
110 -- is returned in the first result_reg_amode
113 -- Use registers for args, and assign args to the regs
114 -- (Can-trigger-gc primops guarantee to have their args in regs)
116 (arg_robust_amodes, liveness_mask, arg_assts)
117 = makePrimOpArgsRobust op arg_amodes
119 liveness_arg = mkIntCLit liveness_mask
123 COpStmt result_amodes op
124 (pin_liveness op liveness_arg arg_robust_amodes)
129 -- Use args from their current amodes.
131 liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
134 COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
137 ) `thenFC` \ (do_before_stack_cleanup,
138 do_just_before_jump) ->
140 case (getPrimOpResultInfo op) of
143 performReturn do_before_stack_cleanup
144 (\ sequel -> robustifySequel may_gc sequel
145 `thenFC` \ (ret_asst, sequel') ->
146 absC (ret_asst `mkAbsCStmts` do_just_before_jump)
148 mkPrimReturnCode sequel')
152 profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields] `thenC`
154 performReturn do_before_stack_cleanup
155 (\ sequel -> robustifySequel may_gc sequel
156 `thenFC` \ (ret_asst, sequel') ->
157 absC (mkAbstractCs [ret_asst,
160 -- Must load info ptr here, not in do_just_before_stack_cleanup,
161 -- because the info-ptr reg clashes with argument registers
164 mkDynamicAlgReturnCode tycon dyn_tag sequel')
168 -- Here, the destination _can_ be an update frame, so we need to make sure that
169 -- infoptr (R2) is loaded with the constructor's info ptr.
171 info_ptr_assign = CAssign (CReg infoptr) info_lbl
174 = case (ctrlReturnConvAlg tycon) of
175 VectoredReturn _ -> vec_lbl
176 UnvectoredReturn _ -> dir_lbl
178 vec_lbl = CTableEntry (CLbl (mkInfoTableVecTblLabel tycon) DataPtrRep)
181 data_con = head (tyConDataCons tycon)
183 (dir_lbl, num_of_fields)
184 = case (dataReturnConvAlg data_con) of
186 -> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrRep,
187 mkIntCLit (length rs)) -- for ticky-ticky only
190 -> pprPanic "CgExpr: can't return prim in heap:" (ppr data_con)
191 -- Never used, and no point in generating
194 -- for all PrimOps except ccalls, we pin the liveness info
195 -- on as the first "argument"
196 -- ToDo: un-duplicate?
198 pin_liveness (CCallOp _ _ _ _ _ _) _ args = args
199 pin_liveness other_op liveness_arg args
202 -- We only need to worry about the sequel when we may GC and the
203 -- sequel is OnStack. If that's the case, arrange to pull the
204 -- sequel out into RetReg before performing the primOp.
206 robustifySequel True sequel@(OnStack _) =
207 sequelToAmode sequel `thenFC` \ amode ->
208 returnFC (CAssign (CReg RetReg) amode, InRetReg)
209 robustifySequel _ sequel = returnFC (AbsCNop, sequel)
212 %********************************************************
214 %* Case expressions *
216 %********************************************************
217 Case-expression conversion is complicated enough to have its own
221 cgExpr (StgCase expr live_vars save_vars uniq alts)
222 = cgCase expr live_vars save_vars uniq alts
226 %********************************************************
230 %********************************************************
231 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
234 cgExpr (StgLet (StgNonRec name rhs) expr)
235 = cgRhs name rhs `thenFC` \ (name, info) ->
236 addBindC name info `thenC`
239 cgExpr (StgLet (StgRec pairs) expr)
240 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
241 listFCs [ cgRhs b e | (b,e) <- pairs ]
242 ) `thenFC` \ new_bindings ->
244 addBindsC new_bindings `thenC`
249 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
250 = -- Figure out what volatile variables to save
251 nukeDeadBindings live_in_whole_let `thenC`
252 saveVolatileVarsAndRegs live_in_rhss
253 `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
255 -- ToDo: cost centre???
257 -- Save those variables right now!
258 absC save_assts `thenC`
260 -- Produce code for the rhss
261 -- and add suitable bindings to the environment
262 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
265 setEndOfBlockInfo rhs_eob_info (cgExpr body)
269 %********************************************************
273 %********************************************************
274 \subsection[scc-codegen]{Converting StgSCC}
276 SCC expressions are treated specially. They set the current cost
279 cgExpr (StgSCC ty cc expr)
280 = ASSERT(sccAbleCostCentre cc)
282 (if isDictCC cc then SLIT("SET_DICT_CCC") else SLIT("SET_CCC"))
283 [mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)]
288 ToDo: counting of dict sccs ...
290 %********************************************************
292 %* Non-top-level bindings *
294 %********************************************************
295 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
297 We rely on the support code in @CgCon@ (to do constructors) and
298 in @CgClosure@ (to do closures).
301 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
302 -- the Id is passed along so a binding can be set up
304 cgRhs name (StgRhsCon maybe_cc con args)
305 = getArgAmodes args `thenFC` \ amodes ->
306 buildDynCon name maybe_cc con amodes (all zero_size args)
308 returnFC (name, idinfo)
310 zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
312 cgRhs name (StgRhsClosure cc bi fvs upd_flag args body)
313 = cgRhsClosure name cc bi fvs args body lf_info
315 lf_info = mkRhsLFInfo fvs upd_flag args body
319 mkRhsLFInfo looks for two special forms of the right-hand side:
323 If neither happens, it just calls mkClosureLFInfo. You might think
324 that mkClosureLFInfo should do all this, but
326 (a) it seems wrong for the latter to look at the structure
329 [March 97: item (b) is no longer true, but I've left mkRhsLFInfo here
330 anyway because of (a).]
332 (b) mkRhsLFInfo has to be in the monad since it looks up in
333 the environment, and it's very tiresome for mkClosureLFInfo to
334 be. Apart from anything else it would make a loop between
335 CgBindery and ClosureInfo.
339 We look at the body of the closure to see if it's a selector---turgid,
340 but nothing deep. We are looking for a closure of {\em exactly} the
343 ... = [the_fv] \ u [] ->
345 con a_1 ... a_n -> a_i
349 mkRhsLFInfo [the_fv] -- Just one free var
350 Updatable -- Updatable thunk
352 (StgCase (StgApp (StgVarArg scrutinee) [{-no args-}] _)
353 _ _ _ -- ignore live vars and uniq...
355 [(con, params, use_mask,
356 (StgApp (StgVarArg selectee) [{-no args-}] _))]
358 | the_fv == scrutinee -- Scrutinee is the only free variable
359 && maybeToBool maybe_offset -- Selectee is a component of the tuple
360 && maybeToBool offset_into_int_maybe
361 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
362 = -- ASSERT(is_single_constructor) -- Should be true, but causes error for SpecTyCon
363 mkSelectorLFInfo scrutinee con offset_into_int
365 (_, params_w_offsets) = layOutDynCon con idPrimRep params
366 maybe_offset = assocMaybe params_w_offsets selectee
367 Just the_offset = maybe_offset
368 offset_into_int_maybe = intOffsetIntoGoods the_offset
369 Just offset_into_int = offset_into_int_maybe
370 is_single_constructor = maybeToBool (maybeTyConSingleCon tycon)
371 tycon = dataConTyCon con
377 Same kind of thing, looking for vector-apply thunks, of the form:
379 x = [...] \ .. [] -> f a1 .. an
381 where f has arity n. We rely on the arity info inside the Id being correct.
386 [] -- No args; a thunk
387 (StgApp (StgVarArg fun_id) args _)
388 | isLocallyDefined fun_id -- Must be defined in this module
389 = -- Get the arity of the fun_id. It's guaranteed to be correct (by setStgVarInfo).
391 arity_maybe = case getIdArity fun_id of
392 ArityExactly n -> Just n
397 | arity > 0 && -- It'd better be a function!
398 arity == length args -- Saturated application
399 -> -- Ha! A VAP thunk
400 mkVapLFInfo fvs upd_flag fun_id args store_fun_in_vap
402 other -> mkClosureLFInfo False{-not top level-} fvs upd_flag []
404 -- If the function is a free variable then it must be stored
405 -- in the thunk too; if it isn't a free variable it must be
406 -- because it's constant, so it doesn't need to be stored in the thunk
407 store_fun_in_vap = fun_id `is_elem` fvs
408 is_elem = isIn "mkClosureLFInfo"
414 mkRhsLFInfo fvs upd_flag args body
415 = mkClosureLFInfo False{-not top level-} fvs upd_flag args
419 %********************************************************
421 %* Let-no-escape bindings
423 %********************************************************
425 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
426 = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot binder rhs
427 `thenFC` \ (binder, info) ->
430 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
431 = fixC (\ new_bindings ->
432 addBindsC new_bindings `thenC`
433 listFCs [ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info
434 maybe_cc_slot b e | (b,e) <- pairs ]
435 ) `thenFC` \ new_bindings ->
437 addBindsC new_bindings
439 -- We add the binders to the live-in-rhss set so that we don't
440 -- delete the bindings for the binder from the environment!
441 full_live_in_rhss = live_in_rhss `unionIdSets` (mkIdSet [b | (b,r) <- pairs])
444 :: StgLiveVars -- Live in rhss
446 -> Maybe VirtualSpBOffset
449 -> FCode (Id, CgIdInfo)
451 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
452 (StgRhsClosure cc bi _ upd_flag args body)
453 = -- We could check the update flag, but currently we don't switch it off
454 -- for let-no-escaped things, so we omit the check too!
456 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
457 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
458 cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot args body
460 -- For a constructor RHS we want to generate a single chunk of code which
461 -- can be jumped to from many places, which will return the constructor.
462 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
463 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
464 (StgRhsCon cc con args)
465 = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} full_live_in_rhss rhs_eob_info maybe_cc_slot
466 [] --No args; the binder is data structure, not a function
467 (StgCon con args full_live_in_rhss)
470 Some PrimOps require a {\em fixed} amount of heap allocation. Rather
471 than tidy away ready for GC and do a full heap check, we simply
472 allocate a completely uninitialised block in-line, just like any other
473 thunk/constructor allocation, and pass it to the PrimOp as its first
474 argument. Remember! The PrimOp is entirely responsible for
475 initialising the object. In particular, the PrimOp had better not
476 trigger GC before it has filled it in, and even then it had better
477 make sure that the GC can find the object somehow.
479 Main current use: allocating SynchVars.
482 getPrimOpArgAmodes op args
483 = getArgAmodes args `thenFC` \ arg_amodes ->
485 case primOpHeapReq op of
486 FixedHeapRequired size -> allocHeap size `thenFC` \ amode ->
487 returnFC (amode : arg_amodes)
489 _ -> returnFC arg_amodes