2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 %********************************************************
6 \section[CgExpr]{Converting @StgExpr@s}
8 %********************************************************
11 #include "HsVersions.h"
14 cgExpr, cgSccExpr, getPrimOpArgAmodes
16 -- and to make the interface self-sufficient...
23 import PrelInfo ( PrimOp(..), PrimOpResultInfo(..), HeapRequirement(..),
24 primOpHeapReq, getPrimOpResultInfo, PrimRep,
26 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
27 IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
29 import Type ( isPrimType, getTyConDataCons )
30 import CLabel ( CLabel, mkPhantomInfoTableLabel, mkInfoTableVecTblLabel )
31 import ClosureInfo ( LambdaFormInfo, mkClosureLFInfo )
32 import CgBindery ( getAtomAmodes )
33 import CgCase ( cgCase, saveVolatileVarsAndRegs )
34 import CgClosure ( cgRhsClosure )
35 import CgCon ( buildDynCon, cgReturnDataCon )
36 import CgHeapery ( allocHeap )
37 import CgLetNoEscape ( cgLetNoEscapeClosure )
38 import CgRetConv -- various things...
39 import CgTailCall ( cgTailCall, performReturn, mkDynamicAlgReturnCode,
42 import CostCentre ( setToAbleCostCentre, isDupdCC, CostCentre )
43 import Maybes ( Maybe(..) )
44 import PrimRep ( getPrimRepSize )
49 This module provides the support code for @StgToAbstractC@ to deal
50 with STG {\em expressions}. See also @CgClosure@, which deals
51 with closures, and @CgCon@, which deals with constructors.
54 cgExpr :: StgExpr -- input
58 %********************************************************
62 %********************************************************
64 ``Applications'' mean {\em tail calls}, a service provided by module
65 @CgTailCall@. This includes literals, which show up as
66 @(STGApp (StgLitArg 42) [])@.
69 cgExpr (StgApp fun args live_vars) = cgTailCall fun args live_vars
72 %********************************************************
74 %* STG ConApps (for inline versions) *
76 %********************************************************
79 cgExpr (StgCon con args live_vars)
80 = getAtomAmodes args `thenFC` \ amodes ->
81 cgReturnDataCon con amodes (all zero_size args) live_vars
83 zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
86 %********************************************************
88 %* STG PrimApps (unboxed primitive ops) *
90 %********************************************************
92 Here is where we insert real live machine instructions.
95 cgExpr x@(StgPrim op args live_vars)
96 = getIntSwitchChkrC `thenFC` \ isw_chkr ->
97 getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
99 result_regs = assignPrimOpResultRegs {-NO:isw_chkr-} op
100 result_amodes = map CReg result_regs
101 may_gc = primOpCanTriggerGC op
102 dyn_tag = head result_amodes
103 -- The tag from a primitive op returning an algebraic data type
104 -- is returned in the first result_reg_amode
107 -- Use registers for args, and assign args to the regs
108 -- (Can-trigger-gc primops guarantee to have their args in regs)
110 (arg_robust_amodes, liveness_mask, arg_assts)
111 = makePrimOpArgsRobust {-NO:isw_chkr-} op arg_amodes
113 liveness_arg = mkIntCLit liveness_mask
117 COpStmt result_amodes op
118 (pin_liveness op liveness_arg arg_robust_amodes)
123 -- Use args from their current amodes.
125 liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
128 COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
131 ) `thenFC` \ (do_before_stack_cleanup,
132 do_just_before_jump) ->
134 case (getPrimOpResultInfo op) of
137 performReturn do_before_stack_cleanup
138 (\ sequel -> robustifySequel may_gc sequel
139 `thenFC` \ (ret_asst, sequel') ->
140 absC (ret_asst `mkAbsCStmts` do_just_before_jump)
142 mkPrimReturnCode sequel')
146 profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields] `thenC`
148 performReturn do_before_stack_cleanup
149 (\ sequel -> robustifySequel may_gc sequel
150 `thenFC` \ (ret_asst, sequel') ->
151 absC (mkAbstractCs [ret_asst,
154 -- Must load info ptr here, not in do_just_before_stack_cleanup,
155 -- because the info-ptr reg clashes with argument registers
158 mkDynamicAlgReturnCode tycon dyn_tag sequel')
162 -- Here, the destination _can_ be an update frame, so we need to make sure that
163 -- infoptr (R2) is loaded with the constructor's info ptr.
165 info_ptr_assign = CAssign (CReg infoptr) info_lbl
168 = case (ctrlReturnConvAlg tycon) of
169 VectoredReturn _ -> vec_lbl
170 UnvectoredReturn _ -> dir_lbl
172 vec_lbl = CTableEntry (CLbl (mkInfoTableVecTblLabel tycon) DataPtrRep)
175 data_con = head (getTyConDataCons tycon)
177 (dir_lbl, num_of_fields)
178 = case (dataReturnConvAlg fake_isw_chkr data_con) of
180 -> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrRep,
181 mkIntCLit (length rs)) -- for ticky-ticky only
184 -> pprPanic "CgExpr: can't return prim in heap:" (ppr PprDebug data_con)
185 -- Never used, and no point in generating
188 fake_isw_chkr x = Nothing
190 -- for all PrimOps except ccalls, we pin the liveness info
191 -- on as the first "argument"
192 -- ToDo: un-duplicate?
194 pin_liveness (CCallOp _ _ _ _ _) _ args = args
195 pin_liveness other_op liveness_arg args
198 -- We only need to worry about the sequel when we may GC and the
199 -- sequel is OnStack. If that's the case, arrange to pull the
200 -- sequel out into RetReg before performing the primOp.
202 robustifySequel True sequel@(OnStack _) =
203 sequelToAmode sequel `thenFC` \ amode ->
204 returnFC (CAssign (CReg RetReg) amode, InRetReg)
205 robustifySequel _ sequel = returnFC (AbsCNop, sequel)
208 %********************************************************
210 %* Case expressions *
212 %********************************************************
213 Case-expression conversion is complicated enough to have its own
217 cgExpr (StgCase expr live_vars save_vars uniq alts)
218 = cgCase expr live_vars save_vars uniq alts
222 %********************************************************
226 %********************************************************
227 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
230 cgExpr (StgLet (StgNonRec name rhs) expr)
231 = cgRhs name rhs `thenFC` \ (name, info) ->
232 addBindC name info `thenC`
235 cgExpr (StgLet (StgRec pairs) expr)
236 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
237 listFCs [ cgRhs b e | (b,e) <- pairs ]
238 ) `thenFC` \ new_bindings ->
240 addBindsC new_bindings `thenC`
245 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
246 = -- Figure out what volatile variables to save
247 nukeDeadBindings live_in_whole_let `thenC`
248 saveVolatileVarsAndRegs live_in_rhss
249 `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
251 -- ToDo: cost centre???
253 -- Save those variables right now!
254 absC save_assts `thenC`
256 -- Produce code for the rhss
257 -- and add suitable bindings to the environment
258 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
261 setEndOfBlockInfo rhs_eob_info (cgExpr body)
265 %********************************************************
269 %********************************************************
270 \subsection[scc-codegen]{Converting StgSCC}
272 SCC expressions are treated specially. They set the current cost
275 For evaluation scoping we also need to save the cost centre in an
276 ``restore CC frame''. We only need to do this once before setting all
280 cgExpr scc_expr@(StgSCC ty cc expr) = cgSccExpr scc_expr
283 @cgSccExpr@ (also used in \tr{CgClosure}):
284 We *don't* set the cost centre for CAF/Dict cost centres
285 [Likewise Subsumed and NoCostCentre, but they probably
286 don't exist in an StgSCC expression.]
288 cgSccExpr (StgSCC ty cc expr)
289 = (if setToAbleCostCentre cc then
290 costCentresC SLIT("SET_CCC")
291 [mkCCostCentre cc, mkIntCLit (if isDupdCC cc then 1 else 0)]
299 %********************************************************
301 %* Non-top-level bindings *
303 %********************************************************
304 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
306 @cgBinding@ is only used for let/letrec, not for unboxed bindings.
307 So the kind should always be @PtrRep@.
309 We rely on the support code in @CgCon@ (to do constructors) and
310 in @CgClosure@ (to do closures).
313 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
314 -- the Id is passed along so a binding can be set up
316 cgRhs name (StgRhsCon maybe_cc con args)
317 = getAtomAmodes args `thenFC` \ amodes ->
318 buildDynCon name maybe_cc con amodes (all zero_size args)
320 returnFC (name, idinfo)
322 zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0
324 cgRhs name (StgRhsClosure cc bi fvs upd_flag args body)
325 = cgRhsClosure name cc bi fvs args body lf_info
327 lf_info = mkClosureLFInfo False{-not top level-} fvs upd_flag args body
331 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
332 = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot binder rhs
333 `thenFC` \ (binder, info) ->
336 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
337 = fixC (\ new_bindings ->
338 addBindsC new_bindings `thenC`
339 listFCs [ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info
340 maybe_cc_slot b e | (b,e) <- pairs ]
341 ) `thenFC` \ new_bindings ->
343 addBindsC new_bindings
345 -- We add the binders to the live-in-rhss set so that we don't
346 -- delete the bindings for the binder from the environment!
347 full_live_in_rhss = live_in_rhss `unionUniqSets` (mkUniqSet [b | (b,r) <- pairs])
350 :: StgLiveVars -- Live in rhss
352 -> Maybe VirtualSpBOffset
355 -> FCode (Id, CgIdInfo)
357 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
358 (StgRhsClosure cc bi _ upd_flag args body)
359 = -- We could check the update flag, but currently we don't switch it off
360 -- for let-no-escaped things, so we omit the check too!
362 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
363 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
364 cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot args body
366 -- For a constructor RHS we want to generate a single chunk of code which
367 -- can be jumped to from many places, which will return the constructor.
368 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
369 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
370 (StgRhsCon cc con args)
371 = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} full_live_in_rhss rhs_eob_info maybe_cc_slot
372 [] --No args; the binder is data structure, not a function
373 (StgCon con args full_live_in_rhss)
376 Some PrimOps require a {\em fixed} amount of heap allocation. Rather
377 than tidy away ready for GC and do a full heap check, we simply
378 allocate a completely uninitialised block in-line, just like any other
379 thunk/constructor allocation, and pass it to the PrimOp as its first
380 argument. Remember! The PrimOp is entirely responsible for
381 initialising the object. In particular, the PrimOp had better not
382 trigger GC before it has filled it in, and even then it had better
383 make sure that the GC can find the object somehow.
385 Main current use: allocating SynchVars.
388 getPrimOpArgAmodes op args
389 = getAtomAmodes args `thenFC` \ arg_amodes ->
391 case primOpHeapReq op of
393 FixedHeapRequired size -> allocHeap size `thenFC` \ amode ->
394 returnFC (amode : arg_amodes)
396 _ -> returnFC arg_amodes