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...
20 IMPORT_Trace -- NB: not just for debugging
21 import Outputable -- ToDo: rm (just for debugging)
22 import Pretty -- ToDo: rm (just for debugging)
28 import AbsPrel ( PrimOp(..), PrimOpResultInfo(..), HeapRequirement(..),
29 primOpHeapReq, getPrimOpResultInfo, PrimKind,
31 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
32 IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
34 import AbsUniType ( isPrimType, getTyConDataCons )
35 import CLabelInfo ( CLabel, mkPhantomInfoTableLabel, mkInfoTableVecTblLabel )
36 import ClosureInfo ( LambdaFormInfo, mkClosureLFInfo )
37 import CgBindery ( getAtomAmodes )
38 import CgCase ( cgCase, saveVolatileVarsAndRegs )
39 import CgClosure ( cgRhsClosure )
40 import CgCon ( buildDynCon, cgReturnDataCon )
41 import CgHeapery ( allocHeap )
42 import CgLetNoEscape ( cgLetNoEscapeClosure )
43 import CgRetConv -- various things...
44 import CgTailCall ( cgTailCall, performReturn, mkDynamicAlgReturnCode,
47 import CostCentre ( setToAbleCostCentre, isDupdCC, CostCentre )
48 import Maybes ( Maybe(..) )
49 import PrimKind ( getKindSize )
54 This module provides the support code for @StgToAbstractC@ to deal
55 with STG {\em expressions}. See also @CgClosure@, which deals
56 with closures, and @CgCon@, which deals with constructors.
59 cgExpr :: PlainStgExpr -- input
63 %********************************************************
67 %********************************************************
69 ``Applications'' mean {\em tail calls}, a service provided by module
70 @CgTailCall@. This includes literals, which show up as
71 @(STGApp (StgLitAtom 42) [])@.
74 cgExpr (StgApp fun args live_vars) = cgTailCall fun args live_vars
77 %********************************************************
79 %* STG ConApps (for inline versions) *
81 %********************************************************
84 cgExpr (StgConApp con args live_vars)
85 = getAtomAmodes args `thenFC` \ amodes ->
86 cgReturnDataCon con amodes (all zero_size args) live_vars
88 zero_size atom = getKindSize (getAtomKind atom) == 0
91 %********************************************************
93 %* STG PrimApps (unboxed primitive ops) *
95 %********************************************************
97 Here is where we insert real live machine instructions.
100 cgExpr x@(StgPrimApp op args live_vars)
101 = -- trace ("cgExpr:PrimApp:"++(ppShow 80 (ppr PprDebug x))) (
102 getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
104 result_regs = assignPrimOpResultRegs op
105 result_amodes = map CReg result_regs
106 may_gc = primOpCanTriggerGC op
107 dyn_tag = head result_amodes
108 -- The tag from a primitive op returning an algebraic data type
109 -- is returned in the first result_reg_amode
112 -- Use registers for args, and assign args to the regs
113 -- (Can-trigger-gc primops guarantee to have their args in regs)
115 (arg_robust_amodes, liveness_mask, arg_assts)
116 = makePrimOpArgsRobust op arg_amodes
118 liveness_arg = mkIntCLit liveness_mask
124 COpStmt result_amodes op
125 (pin_liveness op liveness_arg arg_robust_amodes)
128 spat_prim_stop_macro ]
131 -- Use args from their current amodes.
133 liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n"
136 -- DO NOT want CCallProfMacros in CSimultaneous stuff. Yurgh. (WDP 95/01)
137 -- Arises in compiling PreludeGlaST (and elsewhere??)
140 COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}],
141 -- spat_prim_stop_macro ],
144 ) `thenFC` \ (do_before_stack_cleanup,
145 do_just_before_jump) ->
147 case (getPrimOpResultInfo op) of
150 performReturn do_before_stack_cleanup
151 (\ sequel -> robustifySequel may_gc sequel
152 `thenFC` \ (ret_asst, sequel') ->
153 absC (ret_asst `mkAbsCStmts` do_just_before_jump)
155 mkPrimReturnCode sequel')
159 --OLD: evalCostCentreC "SET_RetCC" [CReg CurCostCentre] `thenC`
160 profCtrC SLIT("RET_NEW_IN_REGS") [] `thenC`
162 performReturn do_before_stack_cleanup
163 (\ sequel -> robustifySequel may_gc sequel
164 `thenFC` \ (ret_asst, sequel') ->
165 absC (mkAbstractCs [ret_asst,
168 -- Must load info ptr here, not in do_just_before_stack_cleanup,
169 -- because the info-ptr reg clashes with argument registers
172 mkDynamicAlgReturnCode tycon dyn_tag sequel')
176 -- Here, the destination _can_ be an update frame, so we need to make sure that
177 -- infoptr (R2) is loaded with the constructor's info ptr.
179 info_ptr_assign = CAssign (CReg infoptr) info_lbl
182 = -- OLD: pprTrace "ctrlReturn7:" (ppr PprDebug tycon) (
183 case (ctrlReturnConvAlg tycon) of
184 VectoredReturn _ -> vec_lbl
185 UnvectoredReturn _ -> dir_lbl
188 vec_lbl = CTableEntry (CLbl (mkInfoTableVecTblLabel tycon) DataPtrKind)
191 data_con = head (getTyConDataCons tycon)
192 dir_lbl = case dataReturnConvAlg data_con of
193 ReturnInRegs _ -> CLbl (mkPhantomInfoTableLabel data_con)
195 ReturnInHeap -> panic "CgExpr: can't return prim in heap"
196 -- Never used, and no point in generating
199 -- for all PrimOps except ccalls, we pin the liveness info
200 -- on as the first "argument"
201 -- ToDo: un-duplicate?
203 pin_liveness (CCallOp _ _ _ _ _) _ args = args
204 pin_liveness other_op liveness_arg args
207 -- We only need to worry about the sequel when we may GC and the
208 -- sequel is OnStack. If that's the case, arrange to pull the
209 -- sequel out into RetReg before performing the primOp.
211 robustifySequel True sequel@(OnStack _) =
212 sequelToAmode sequel `thenFC` \ amode ->
213 returnFC (CAssign (CReg RetReg) amode, InRetReg)
214 robustifySequel _ sequel = returnFC (AbsCNop, sequel)
216 spat_prim_macro = CCallProfCtrMacro SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM") IntKind]
217 spat_prim_stop_macro = CCallProfCtrMacro SLIT("SET_ACTIVITY") [CLitLit SLIT("ACT_PRIM_STOP") IntKind]
221 %********************************************************
223 %* Case expressions *
225 %********************************************************
226 Case-expression conversion is complicated enough to have its own
230 cgExpr (StgCase expr live_vars save_vars uniq alts)
231 = cgCase expr live_vars save_vars uniq alts
235 %********************************************************
239 %********************************************************
240 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
243 cgExpr (StgLet (StgNonRec name rhs) expr)
244 = cgRhs name rhs `thenFC` \ (name, info) ->
245 addBindC name info `thenC`
248 cgExpr (StgLet (StgRec pairs) expr)
249 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
250 listFCs [ cgRhs b e | (b,e) <- pairs ]
251 ) `thenFC` \ new_bindings ->
253 addBindsC new_bindings `thenC`
258 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
259 = -- Figure out what volatile variables to save
260 nukeDeadBindings live_in_whole_let `thenC`
261 saveVolatileVarsAndRegs live_in_rhss
262 `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
264 -- ToDo: cost centre???
266 -- Save those variables right now!
267 absC save_assts `thenC`
269 -- Produce code for the rhss
270 -- and add suitable bindings to the environment
271 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
274 setEndOfBlockInfo rhs_eob_info (cgExpr body)
278 %********************************************************
282 %********************************************************
283 \subsection[scc-codegen]{Converting StgSCC}
285 SCC expressions are treated specially. They set the current cost
288 For evaluation scoping we also need to save the cost centre in an
289 ``restore CC frame''. We only need to do this once before setting all
293 cgExpr scc_expr@(StgSCC ty cc expr)
294 --OLD:WDP:94/06 = evalPushRCCFrame (isPrimType ty) (cgSccExpr scc_expr)
298 @cgSccExpr@ (also used in \tr{CgClosure}):
299 We *don't* set the cost centre for CAF/Dict cost centres
300 [Likewise Subsumed and NoCostCentre, but they probably
301 don't exist in an StgSCC expression.]
303 cgSccExpr (StgSCC ty cc expr)
304 = (if setToAbleCostCentre cc then
305 costCentresC SLIT("SET_CCC")
306 [mkCCostCentre cc, mkIntCLit (if isDupdCC cc then 1 else 0)]
314 %********************************************************
316 %* Non-top-level bindings *
318 %********************************************************
319 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
321 @cgBinding@ is only used for let/letrec, not for unboxed bindings.
322 So the kind should always be @PtrKind@.
324 We rely on the support code in @CgCon@ (to do constructors) and
325 in @CgClosure@ (to do closures).
328 cgRhs :: Id -> PlainStgRhs -> FCode (Id, CgIdInfo)
329 -- the Id is passed along so a binding can be set up
331 cgRhs name (StgRhsCon maybe_cc con args)
332 = getAtomAmodes args `thenFC` \ amodes ->
333 buildDynCon name maybe_cc con amodes (all zero_size args)
335 returnFC (name, idinfo)
337 zero_size atom = getKindSize (getAtomKind atom) == 0
339 cgRhs name (StgRhsClosure cc bi fvs upd_flag args body)
340 = cgRhsClosure name cc bi fvs args body lf_info
342 lf_info = mkClosureLFInfo False{-not top level-} fvs upd_flag args body
346 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs)
347 = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot binder rhs
348 `thenFC` \ (binder, info) ->
351 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
352 = fixC (\ new_bindings ->
353 addBindsC new_bindings `thenC`
354 listFCs [ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info
355 maybe_cc_slot b e | (b,e) <- pairs ]
356 ) `thenFC` \ new_bindings ->
358 addBindsC new_bindings
360 -- We add the binders to the live-in-rhss set so that we don't
361 -- delete the bindings for the binder from the environment!
362 full_live_in_rhss = live_in_rhss `unionUniqSets` (mkUniqSet [b | (b,r) <- pairs])
365 :: PlainStgLiveVars -- Live in rhss
367 -> Maybe VirtualSpBOffset
370 -> FCode (Id, CgIdInfo)
372 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
373 (StgRhsClosure cc bi _ upd_flag args body)
374 = -- We could check the update flag, but currently we don't switch it off
375 -- for let-no-escaped things, so we omit the check too!
377 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
378 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
379 cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot args body
381 -- For a constructor RHS we want to generate a single chunk of code which
382 -- can be jumped to from many places, which will return the constructor.
383 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
384 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder
385 (StgRhsCon cc con args)
386 = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} full_live_in_rhss rhs_eob_info maybe_cc_slot
387 [] --No args; the binder is data structure, not a function
388 (StgConApp con args full_live_in_rhss)
391 Some PrimOps require a {\em fixed} amount of heap allocation. Rather
392 than tidy away ready for GC and do a full heap check, we simply
393 allocate a completely uninitialised block in-line, just like any other
394 thunk/constructor allocation, and pass it to the PrimOp as its first
395 argument. Remember! The PrimOp is entirely responsible for
396 initialising the object. In particular, the PrimOp had better not
397 trigger GC before it has filled it in, and even then it had better
398 make sure that the GC can find the object somehow.
400 Main current use: allocating SynchVars.
403 getPrimOpArgAmodes op args
404 = getAtomAmodes args `thenFC` \ arg_amodes ->
406 case primOpHeapReq op of
408 FixedHeapRequired size -> allocHeap size `thenFC` \ amode ->
409 returnFC (amode : arg_amodes)
411 _ -> returnFC arg_amodes