2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 %********************************************************
6 \section[CgExpr]{Converting @StgExpr@s}
8 %********************************************************
11 #include "HsVersions.h"
13 module CgExpr ( cgExpr, getPrimOpArgAmodes ) where
16 IMPORT_DELOOPER(CgLoop2) -- here for paranoia-checking
18 import Constants ( mAX_SPEC_SELECTEE_SIZE )
23 import AbsCUtils ( mkAbsCStmts, mkAbstractCs )
24 import CgBindery ( getArgAmodes, getCAddrModeAndInfo, CgIdInfo )
25 import CgCase ( cgCase, saveVolatileVarsAndRegs )
26 import CgClosure ( cgRhsClosure )
27 import CgCon ( buildDynCon, cgReturnDataCon )
28 import CgHeapery ( allocHeap )
29 import CgLetNoEscape ( cgLetNoEscapeClosure )
30 import CgRetConv ( dataReturnConvAlg, ctrlReturnConvAlg,
31 DataReturnConvention(..), CtrlReturnConvention(..),
32 assignPrimOpResultRegs, makePrimOpArgsRobust
34 import CgTailCall ( cgTailCall, performReturn,
35 mkDynamicAlgReturnCode, mkPrimReturnCode
37 import CLabel ( mkPhantomInfoTableLabel, mkInfoTableVecTblLabel )
38 import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo, mkVapLFInfo,
40 import CostCentre ( sccAbleCostCentre, isDictCC, isSccCountCostCentre )
41 import HeapOffs ( SYN_IE(VirtualSpBOffset), intOffsetIntoGoods )
42 import Id ( dataConTyCon, idPrimRep, getIdArity,
43 mkIdSet, unionIdSets, GenId{-instance Outputable-},
46 import IdInfo ( ArityInfo(..) )
47 import Name ( isLocallyDefined )
48 import Outputable ( PprStyle(..), Outputable(..) )
50 import PrimOp ( primOpCanTriggerGC, primOpHeapReq, HeapRequirement(..),
51 getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..)
53 import PrimRep ( getPrimRepSize, PrimRep(..) )
54 import TyCon ( tyConDataCons, maybeTyConSingleCon )
55 import Maybes ( assocMaybe, maybeToBool )
56 import Util ( panic, isIn, pprPanic, assertPanic )
59 This module provides the support code for @StgToAbstractC@ to deal
60 with STG {\em expressions}. See also @CgClosure@, which deals
61 with closures, and @CgCon@, which deals with constructors.
64 cgExpr :: StgExpr -- input
68 %********************************************************
72 %********************************************************
74 ``Applications'' mean {\em tail calls}, a service provided by module
75 @CgTailCall@. This includes literals, which show up as
76 @(STGApp (StgLitArg 42) [])@.
79 cgExpr (StgApp fun args live_vars) = cgTailCall fun args live_vars
82 %********************************************************
84 %* STG ConApps (for inline versions) *
86 %********************************************************
89 cgExpr (StgCon con args live_vars)
90 = getArgAmodes args `thenFC` \ amodes ->
91 cgReturnDataCon con amodes (all zero_size args) live_vars
93 zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
96 %********************************************************
98 %* STG PrimApps (unboxed primitive ops) *
100 %********************************************************
102 Here is where we insert real live machine instructions.
105 cgExpr x@(StgPrim op args live_vars)
106 = ASSERT(op /= SeqOp) -- can't handle SeqOp
107 getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
109 result_regs = assignPrimOpResultRegs op
110 result_amodes = map CReg result_regs
111 may_gc = primOpCanTriggerGC op
112 dyn_tag = head result_amodes
113 -- The tag from a primitive op returning an algebraic data type
114 -- is returned in the first result_reg_amode
117 -- Use registers for args, and assign args to the regs
118 -- (Can-trigger-gc primops guarantee to have their args in regs)
120 (arg_robust_amodes, liveness_mask, arg_assts)
121 = makePrimOpArgsRobust op arg_amodes
123 liveness_arg = mkIntCLit liveness_mask
127 COpStmt result_amodes op
128 (pin_liveness op liveness_arg arg_robust_amodes)
133 -- Use args from their current amodes.
135 liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
138 COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
141 ) `thenFC` \ (do_before_stack_cleanup,
142 do_just_before_jump) ->
144 case (getPrimOpResultInfo op) of
147 performReturn do_before_stack_cleanup
148 (\ sequel -> robustifySequel may_gc sequel
149 `thenFC` \ (ret_asst, sequel') ->
150 absC (ret_asst `mkAbsCStmts` do_just_before_jump)
152 mkPrimReturnCode sequel')
156 profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields] `thenC`
158 performReturn do_before_stack_cleanup
159 (\ sequel -> robustifySequel may_gc sequel
160 `thenFC` \ (ret_asst, sequel') ->
161 absC (mkAbstractCs [ret_asst,
164 -- Must load info ptr here, not in do_just_before_stack_cleanup,
165 -- because the info-ptr reg clashes with argument registers
168 mkDynamicAlgReturnCode tycon dyn_tag sequel')
172 -- Here, the destination _can_ be an update frame, so we need to make sure that
173 -- infoptr (R2) is loaded with the constructor's info ptr.
175 info_ptr_assign = CAssign (CReg infoptr) info_lbl
178 = case (ctrlReturnConvAlg tycon) of
179 VectoredReturn _ -> vec_lbl
180 UnvectoredReturn _ -> dir_lbl
182 vec_lbl = CTableEntry (CLbl (mkInfoTableVecTblLabel tycon) DataPtrRep)
185 data_con = head (tyConDataCons tycon)
187 (dir_lbl, num_of_fields)
188 = case (dataReturnConvAlg data_con) of
190 -> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrRep,
191 mkIntCLit (length rs)) -- for ticky-ticky only
194 -> pprPanic "CgExpr: can't return prim in heap:" (ppr PprDebug data_con)
195 -- Never used, and no point in generating
198 -- for all PrimOps except ccalls, we pin the liveness info
199 -- on as the first "argument"
200 -- ToDo: un-duplicate?
202 pin_liveness (CCallOp _ _ _ _ _) _ args = args
203 pin_liveness other_op liveness_arg args
206 -- We only need to worry about the sequel when we may GC and the
207 -- sequel is OnStack. If that's the case, arrange to pull the
208 -- sequel out into RetReg before performing the primOp.
210 robustifySequel True sequel@(OnStack _) =
211 sequelToAmode sequel `thenFC` \ amode ->
212 returnFC (CAssign (CReg RetReg) amode, InRetReg)
213 robustifySequel _ sequel = returnFC (AbsCNop, sequel)
216 %********************************************************
218 %* Case expressions *
220 %********************************************************
221 Case-expression conversion is complicated enough to have its own
225 cgExpr (StgCase expr live_vars save_vars uniq alts)
226 = cgCase expr live_vars save_vars uniq alts
230 %********************************************************
234 %********************************************************
235 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
238 cgExpr (StgLet (StgNonRec name rhs) expr)
239 = cgRhs name rhs `thenFC` \ (name, info) ->
240 addBindC name info `thenC`
243 cgExpr (StgLet (StgRec pairs) expr)
244 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
245 listFCs [ cgRhs b e | (b,e) <- pairs ]
246 ) `thenFC` \ new_bindings ->
248 addBindsC new_bindings `thenC`
253 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
254 = -- Figure out what volatile variables to save
255 nukeDeadBindings live_in_whole_let `thenC`
256 saveVolatileVarsAndRegs live_in_rhss
257 `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
259 -- ToDo: cost centre???
261 -- Save those variables right now!
262 absC save_assts `thenC`
264 -- Produce code for the rhss
265 -- and add suitable bindings to the environment
266 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
269 setEndOfBlockInfo rhs_eob_info (cgExpr body)
273 %********************************************************
277 %********************************************************
278 \subsection[scc-codegen]{Converting StgSCC}
280 SCC expressions are treated specially. They set the current cost
283 cgExpr (StgSCC ty cc expr)
284 = ASSERT(sccAbleCostCentre cc)
286 (if isDictCC cc then SLIT("SET_DICT_CCC") else SLIT("SET_CCC"))
287 [mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)]
292 ToDo: counting of dict sccs ...
294 %********************************************************
296 %* Non-top-level bindings *
298 %********************************************************
299 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
301 We rely on the support code in @CgCon@ (to do constructors) and
302 in @CgClosure@ (to do closures).
305 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
306 -- the Id is passed along so a binding can be set up
308 cgRhs name (StgRhsCon maybe_cc con args)
309 = getArgAmodes args `thenFC` \ amodes ->
310 buildDynCon name maybe_cc con amodes (all zero_size args)
312 returnFC (name, idinfo)
314 zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
316 cgRhs name (StgRhsClosure cc bi fvs upd_flag args body)
317 = cgRhsClosure name cc bi fvs args body lf_info
319 lf_info = mkRhsLFInfo fvs upd_flag args body
323 mkRhsLFInfo looks for two special forms of the right-hand side:
327 If neither happens, it just calls mkClosureLFInfo. You might think
328 that mkClosureLFInfo should do all this, but
330 (a) it seems wrong for the latter to look at the structure
333 [March 97: item (b) is no longer true, but I've left mkRhsLFInfo here
334 anyway because of (a).]
336 (b) mkRhsLFInfo has to be in the monad since it looks up in
337 the environment, and it's very tiresome for mkClosureLFInfo to
338 be. Apart from anything else it would make a loop between
339 CgBindery and ClosureInfo.
343 We look at the body of the closure to see if it's a selector---turgid,
344 but nothing deep. We are looking for a closure of {\em exactly} the
347 ... = [the_fv] \ u [] ->
349 con a_1 ... a_n -> a_i
353 mkRhsLFInfo [the_fv] -- Just one free var
354 Updatable -- Updatable thunk
356 (StgCase (StgApp (StgVarArg scrutinee) [{-no args-}] _)
357 _ _ _ -- ignore live vars and uniq...
359 [(con, params, use_mask,
360 (StgApp (StgVarArg selectee) [{-no args-}] _))]
362 | the_fv == scrutinee -- Scrutinee is the only free variable
363 && maybeToBool maybe_offset -- Selectee is a component of the tuple
364 && maybeToBool offset_into_int_maybe
365 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
366 = -- ASSERT(is_single_constructor) -- Should be true, but causes error for SpecTyCon
367 mkSelectorLFInfo scrutinee con offset_into_int
369 (_, params_w_offsets) = layOutDynCon con idPrimRep params
370 maybe_offset = assocMaybe params_w_offsets selectee
371 Just the_offset = maybe_offset
372 offset_into_int_maybe = intOffsetIntoGoods the_offset
373 Just offset_into_int = offset_into_int_maybe
374 is_single_constructor = maybeToBool (maybeTyConSingleCon tycon)
375 tycon = dataConTyCon con
381 Same kind of thing, looking for vector-apply thunks, of the form:
383 x = [...] \ .. [] -> f a1 .. an
385 where f has arity n. We rely on the arity info inside the Id being correct.
390 [] -- No args; a thunk
391 (StgApp (StgVarArg fun_id) args _)
392 | isLocallyDefined fun_id -- Must be defined in this module
393 = -- Get the arity of the fun_id. It's guaranteed to be correct (by setStgVarInfo).
395 arity_maybe = case getIdArity fun_id of
396 ArityExactly n -> Just n
401 | arity > 0 && -- It'd better be a function!
402 arity == length args -- Saturated application
403 -> -- Ha! A VAP thunk
404 mkVapLFInfo fvs upd_flag fun_id args store_fun_in_vap
406 other -> mkClosureLFInfo False{-not top level-} fvs upd_flag []
408 -- If the function is a free variable then it must be stored
409 -- in the thunk too; if it isn't a free variable it must be
410 -- because it's constant, so it doesn't need to be stored in the thunk
411 store_fun_in_vap = fun_id `is_elem` fvs
412 is_elem = isIn "mkClosureLFInfo"
418 mkRhsLFInfo fvs upd_flag args body
419 = mkClosureLFInfo False{-not top level-} fvs upd_flag args
423 %********************************************************
425 %* Let-no-escape bindings
427 %********************************************************
429 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
430 = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot binder rhs
431 `thenFC` \ (binder, info) ->
434 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
435 = fixC (\ new_bindings ->
436 addBindsC new_bindings `thenC`
437 listFCs [ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info
438 maybe_cc_slot b e | (b,e) <- pairs ]
439 ) `thenFC` \ new_bindings ->
441 addBindsC new_bindings
443 -- We add the binders to the live-in-rhss set so that we don't
444 -- delete the bindings for the binder from the environment!
445 full_live_in_rhss = live_in_rhss `unionIdSets` (mkIdSet [b | (b,r) <- pairs])
448 :: StgLiveVars -- Live in rhss
450 -> Maybe VirtualSpBOffset
453 -> FCode (Id, CgIdInfo)
455 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
456 (StgRhsClosure cc bi _ upd_flag args body)
457 = -- We could check the update flag, but currently we don't switch it off
458 -- for let-no-escaped things, so we omit the check too!
460 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
461 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
462 cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot args body
464 -- For a constructor RHS we want to generate a single chunk of code which
465 -- can be jumped to from many places, which will return the constructor.
466 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
467 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
468 (StgRhsCon cc con args)
469 = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} full_live_in_rhss rhs_eob_info maybe_cc_slot
470 [] --No args; the binder is data structure, not a function
471 (StgCon con args full_live_in_rhss)
474 Some PrimOps require a {\em fixed} amount of heap allocation. Rather
475 than tidy away ready for GC and do a full heap check, we simply
476 allocate a completely uninitialised block in-line, just like any other
477 thunk/constructor allocation, and pass it to the PrimOp as its first
478 argument. Remember! The PrimOp is entirely responsible for
479 initialising the object. In particular, the PrimOp had better not
480 trigger GC before it has filled it in, and even then it had better
481 make sure that the GC can find the object somehow.
483 Main current use: allocating SynchVars.
486 getPrimOpArgAmodes op args
487 = getArgAmodes args `thenFC` \ arg_amodes ->
489 case primOpHeapReq op of
490 FixedHeapRequired size -> allocHeap size `thenFC` \ amode ->
491 returnFC (amode : arg_amodes)
493 _ -> returnFC arg_amodes