2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgExpr.lhs,v 1.58 2004/08/10 09:02:41 simonmar Exp $
6 %********************************************************
8 \section[CgExpr]{Converting @StgExpr@s}
10 %********************************************************
13 module CgExpr ( cgExpr ) where
15 #include "HsVersions.h"
17 import Constants ( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE )
21 import AbsCUtils ( mkAbstractCs, getAmodeRep, shimFCallArg )
22 import CLabel ( mkClosureTblLabel )
24 import SMRep ( fixedHdrSize )
25 import CoreSyn ( AltCon(..) )
26 import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo,
27 nukeDeadBindings, addBindC, addBindsC )
28 import CgCase ( cgCase, saveVolatileVarsAndRegs )
29 import CgClosure ( cgRhsClosure, cgStdRhsClosure )
30 import CgCon ( buildDynCon, cgReturnDataCon )
31 import CgLetNoEscape ( cgLetNoEscapeClosure )
32 import CgRetConv ( dataReturnConvPrim )
33 import CgTailCall ( cgTailCall, performReturn, performPrimReturn,
34 mkDynamicAlgReturnCode, mkPrimReturnCode,
35 tailCallPrimOp, ccallReturnUnboxedTuple
37 import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo,
38 mkApLFInfo, layOutDynConstr )
39 import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
40 import Id ( idPrimRep, Id )
42 import PrimOp ( primOpOutOfLine, getPrimOpResultInfo,
43 PrimOp(..), PrimOpResultInfo(..) )
44 import PrimRep ( PrimRep(..), isFollowableRep )
45 import TyCon ( isUnboxedTupleTyCon, isEnumerationTyCon )
46 import Type ( Type, typePrimRep, tyConAppArgs,
47 tyConAppTyCon, repType )
48 import Maybes ( maybeToBool )
49 import ListSetOps ( assocMaybe )
50 import Unique ( mkBuiltinUnique )
51 import BasicTypes ( TopLevelFlag(..), RecFlag(..) )
52 import Util ( lengthIs )
56 This module provides the support code for @StgToAbstractC@ to deal
57 with STG {\em expressions}. See also @CgClosure@, which deals
58 with closures, and @CgCon@, which deals with constructors.
61 cgExpr :: StgExpr -- input
65 %********************************************************
69 %********************************************************
71 ``Applications'' mean {\em tail calls}, a service provided by module
72 @CgTailCall@. This includes literals, which show up as
73 @(STGApp (StgLitArg 42) [])@.
76 cgExpr (StgApp fun args) = cgTailCall fun args
79 %********************************************************
81 %* STG ConApps (for inline versions) *
83 %********************************************************
86 cgExpr (StgConApp con args)
87 = getArgAmodes args `thenFC` \ amodes ->
88 cgReturnDataCon con amodes
91 Literals are similar to constructors; they return by putting
92 themselves in an appropriate register and returning to the address on
97 = performPrimReturn (text "literal" <+> ppr lit) (CLit lit)
101 %********************************************************
103 %* STG PrimApps (unboxed primitive ops) *
105 %********************************************************
107 Here is where we insert real live machine instructions.
109 NOTE about _ccall_GC_:
111 A _ccall_GC_ is treated as an out-of-line primop (returns True
112 for primOpOutOfLine) so that when we see the call in case context
113 case (ccall ...) of { ... }
114 we get a proper stack frame on the stack when we perform it. When we
115 get in a tail-call position, however, we need to actually perform the
116 call, so we treat it as an inline primop.
119 cgExpr (StgOpApp op@(StgFCallOp _ _) args res_ty)
120 = primRetUnboxedTuple op args res_ty
122 -- tagToEnum# is special: we need to pull the constructor out of the table,
123 -- and perform an appropriate return.
125 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
126 = ASSERT(isEnumerationTyCon tycon)
127 getArgAmode arg `thenFC` \amode ->
128 -- save the tag in a temporary in case amode overlaps
130 absC (CAssign dyn_tag amode) `thenC`
134 (CLbl (mkClosureTblLabel tycon) PtrRep)
135 dyn_tag PtrRep) PtrRep))
136 (\ sequel -> mkDynamicAlgReturnCode tycon dyn_tag sequel)
138 dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
139 -- The '0' is just to get a random spare temp
141 -- if you're reading this code in the attempt to figure
142 -- out why the compiler panic'ed here, it is probably because
143 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
144 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
148 tycon = tyConAppTyCon res_ty
151 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
152 | primOpOutOfLine primop
153 = tailCallPrimOp primop args
156 = getArgAmodes args `thenFC` \ arg_amodes ->
158 case (getPrimOpResultInfo primop) of
161 let result_amode = CReg (dataReturnConvPrim kind) in
163 (COpStmt [result_amode] op arg_amodes [{-no vol_regs-}])
164 (mkPrimReturnCode (text "primapp)" <+> ppr x))
166 -- otherwise, must be returning an enumerated type (eg. Bool).
167 -- we've only got the tag in R2, so we have to load the constructor
171 | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty
173 | isEnumerationTyCon tycon ->
175 (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}])
177 absC (CAssign (CReg node) closure_lbl) `thenC`
178 mkDynamicAlgReturnCode tycon dyn_tag sequel)
181 -- Pull a unique out of thin air to put the tag in.
182 -- It shouldn't matter if this overlaps with anything - we're
183 -- about to return anyway.
184 dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
186 closure_lbl = CVal (CIndex
187 (CLbl (mkClosureTblLabel tycon) PtrRep)
188 dyn_tag PtrRep) PtrRep
192 %********************************************************
194 %* Case expressions *
196 %********************************************************
197 Case-expression conversion is complicated enough to have its own
201 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
202 = cgCase expr live_vars save_vars bndr srt alt_type alts
206 %********************************************************
210 %********************************************************
211 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
214 cgExpr (StgLet (StgNonRec name rhs) expr)
215 = cgRhs name rhs `thenFC` \ (name, info) ->
216 addBindC name info `thenC`
219 cgExpr (StgLet (StgRec pairs) expr)
220 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
221 listFCs [ cgRhs b e | (b,e) <- pairs ]
222 ) `thenFC` \ new_bindings ->
224 addBindsC new_bindings `thenC`
229 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
230 = -- Figure out what volatile variables to save
231 nukeDeadBindings live_in_whole_let `thenC`
232 saveVolatileVarsAndRegs live_in_rhss
233 `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
235 -- Save those variables right now!
236 absC save_assts `thenC`
238 -- Produce code for the rhss
239 -- and add suitable bindings to the environment
240 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
243 setEndOfBlockInfo rhs_eob_info (cgExpr body)
247 %********************************************************
251 %********************************************************
253 SCC expressions are treated specially. They set the current cost
256 cgExpr (StgSCC cc expr)
257 = ASSERT(sccAbleCostCentre cc)
260 [mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)]
265 ToDo: counting of dict sccs ...
267 %********************************************************
269 %* Non-top-level bindings *
271 %********************************************************
272 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
274 We rely on the support code in @CgCon@ (to do constructors) and
275 in @CgClosure@ (to do closures).
278 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
279 -- the Id is passed along so a binding can be set up
281 cgRhs name (StgRhsCon maybe_cc con args)
282 = getArgAmodes args `thenFC` \ amodes ->
283 buildDynCon name maybe_cc con amodes `thenFC` \ idinfo ->
284 returnFC (name, idinfo)
286 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
287 = mkRhsClosure name cc bi srt fvs upd_flag args body
290 mkRhsClosure looks for two special forms of the right-hand side:
294 If neither happens, it just calls mkClosureLFInfo. You might think
295 that mkClosureLFInfo should do all this, but it seems wrong for the
296 latter to look at the structure of an expression
300 We look at the body of the closure to see if it's a selector---turgid,
301 but nothing deep. We are looking for a closure of {\em exactly} the
304 ... = [the_fv] \ u [] ->
306 con a_1 ... a_n -> a_i
310 mkRhsClosure bndr cc bi srt
311 [the_fv] -- Just one free var
312 upd_flag -- Updatable thunk
314 body@(StgCase (StgApp scrutinee [{-no args-}])
315 _ _ _ _ -- ignore uniq, etc.
317 [(DataAlt con, params, use_mask,
318 (StgApp selectee [{-no args-}]))])
319 | the_fv == scrutinee -- Scrutinee is the only free variable
320 && maybeToBool maybe_offset -- Selectee is a component of the tuple
321 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
322 = -- NOT TRUE: ASSERT(is_single_constructor)
323 -- The simplifier may have statically determined that the single alternative
324 -- is the only possible case and eliminated the others, even if there are
325 -- other constructors in the datatype. It's still ok to make a selector
326 -- thunk in this case, because we *know* which constructor the scrutinee
328 cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
330 lf_info = mkSelectorLFInfo bndr offset_into_int (isUpdatable upd_flag)
331 (_, params_w_offsets) = layOutDynConstr con idPrimRep params
332 -- Just want the layout
333 maybe_offset = assocMaybe params_w_offsets selectee
334 Just the_offset = maybe_offset
335 offset_into_int = the_offset - fixedHdrSize
341 A more generic AP thunk of the form
343 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
345 A set of these is compiled statically into the RTS, so we just use
346 those. We could extend the idea to thunks where some of the x_i are
347 global ids (and hence not free variables), but this would entail
348 generating a larger thunk. It might be an option for non-optimising
351 We only generate an Ap thunk if all the free variables are pointers,
352 for semi-obvious reasons.
355 mkRhsClosure bndr cc bi srt
358 [] -- No args; a thunk
359 body@(StgApp fun_id args)
361 | args `lengthIs` (arity-1)
362 && all isFollowableRep (map idPrimRep fvs)
363 && isUpdatable upd_flag
364 && arity <= mAX_SPEC_AP_SIZE
367 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
370 lf_info = mkApLFInfo bndr upd_flag arity
371 -- the payload has to be in the correct order, hence we can't
373 payload = StgVarArg fun_id : args
380 mkRhsClosure bndr cc bi srt fvs upd_flag args body
381 = cgRhsClosure bndr cc bi srt fvs args body lf_info
383 lf_info = mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
387 %********************************************************
389 %* Let-no-escape bindings
391 %********************************************************
393 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
394 (StgNonRec binder rhs)
395 = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot
396 NonRecursive binder rhs
397 `thenFC` \ (binder, info) ->
400 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
401 = fixC (\ new_bindings ->
402 addBindsC new_bindings `thenC`
403 listFCs [ cgLetNoEscapeRhs full_live_in_rhss
404 rhs_eob_info maybe_cc_slot Recursive b e
406 ) `thenFC` \ new_bindings ->
408 addBindsC new_bindings
410 -- We add the binders to the live-in-rhss set so that we don't
411 -- delete the bindings for the binder from the environment!
412 full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
415 :: StgLiveVars -- Live in rhss
417 -> Maybe VirtualSpOffset
421 -> FCode (Id, CgIdInfo)
423 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
424 (StgRhsClosure cc bi _ upd_flag srt args body)
425 = -- We could check the update flag, but currently we don't switch it off
426 -- for let-no-escaped things, so we omit the check too!
428 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
429 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
430 cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
431 maybe_cc_slot rec args body
433 -- For a constructor RHS we want to generate a single chunk of code which
434 -- can be jumped to from many places, which will return the constructor.
435 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
436 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
437 (StgRhsCon cc con args)
438 = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
439 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
440 [] --No args; the binder is data structure, not a function
444 Little helper for primitives that return unboxed tuples.
448 primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
449 primRetUnboxedTuple op args res_ty
450 = getArgAmodes args `thenFC` \ arg_amodes1 ->
452 For a foreign call, we might need to fiddle with some of the args:
453 for example, when passing a ByteArray#, we pass a ptr to the goods
454 rather than the heap object.
458 | StgFCallOp{} <- op = zipWith shimFCallArg args arg_amodes1
459 | otherwise = arg_amodes1
462 put all the arguments in temporaries so they don't get stomped when
463 we push the return address.
467 arg_uniqs = map mkBuiltinUnique [0 .. n_args-1]
468 arg_reps = map getAmodeRep arg_amodes
469 arg_temps = zipWith CTemp arg_uniqs arg_reps
471 absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC`
473 allocate some temporaries for the return values.
476 ty_args = tyConAppArgs (repType res_ty)
477 prim_reps = map typePrimRep ty_args
478 temp_uniqs = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1]
479 temp_amodes = zipWith CTemp temp_uniqs prim_reps
481 ccallReturnUnboxedTuple temp_amodes
482 (absC (COpStmt temp_amodes op arg_temps []))