2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgExpr.lhs,v 1.54 2003/07/02 13:12:36 simonpj 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 )
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, restoreCurrentCostCentre )
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 TysPrim ( foreignObjPrimTyCon, arrayPrimTyCon,
45 byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
46 mutableArrayPrimTyCon )
47 import PrimRep ( PrimRep(..), isFollowableRep )
48 import TyCon ( isUnboxedTupleTyCon, isEnumerationTyCon )
49 import Type ( Type, typePrimRep, tyConAppArgs, tyConAppTyCon, repType )
50 import Maybes ( maybeToBool )
51 import ListSetOps ( assocMaybe )
52 import Unique ( mkBuiltinUnique )
53 import BasicTypes ( TopLevelFlag(..), RecFlag(..) )
54 import Util ( lengthIs )
58 This module provides the support code for @StgToAbstractC@ to deal
59 with STG {\em expressions}. See also @CgClosure@, which deals
60 with closures, and @CgCon@, which deals with constructors.
63 cgExpr :: StgExpr -- input
67 %********************************************************
71 %********************************************************
73 ``Applications'' mean {\em tail calls}, a service provided by module
74 @CgTailCall@. This includes literals, which show up as
75 @(STGApp (StgLitArg 42) [])@.
78 cgExpr (StgApp fun args) = cgTailCall fun args
81 %********************************************************
83 %* STG ConApps (for inline versions) *
85 %********************************************************
88 cgExpr (StgConApp con args)
89 = getArgAmodes args `thenFC` \ amodes ->
90 cgReturnDataCon con amodes
93 Literals are similar to constructors; they return by putting
94 themselves in an appropriate register and returning to the address on
99 = performPrimReturn (text "literal" <+> ppr lit) (CLit lit)
103 %********************************************************
105 %* STG PrimApps (unboxed primitive ops) *
107 %********************************************************
109 Here is where we insert real live machine instructions.
111 NOTE about _ccall_GC_:
113 A _ccall_GC_ is treated as an out-of-line primop (returns True
114 for primOpOutOfLine) so that when we see the call in case context
115 case (ccall ...) of { ... }
116 we get a proper stack frame on the stack when we perform it. When we
117 get in a tail-call position, however, we need to actually perform the
118 call, so we treat it as an inline primop.
121 cgExpr (StgOpApp op@(StgFCallOp _ _) args res_ty)
122 = primRetUnboxedTuple op args res_ty
124 -- tagToEnum# is special: we need to pull the constructor out of the table,
125 -- and perform an appropriate return.
127 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
128 = ASSERT(isEnumerationTyCon tycon)
129 getArgAmode arg `thenFC` \amode ->
130 -- save the tag in a temporary in case amode overlaps
132 absC (CAssign dyn_tag amode) `thenC`
136 (CLbl (mkClosureTblLabel tycon) PtrRep)
137 dyn_tag PtrRep) PtrRep))
138 (\ sequel -> mkDynamicAlgReturnCode tycon dyn_tag sequel)
140 dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
141 -- The '0' is just to get a random spare temp
143 -- if you're reading this code in the attempt to figure
144 -- out why the compiler panic'ed here, it is probably because
145 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
146 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
150 tycon = tyConAppTyCon res_ty
153 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
154 | primOpOutOfLine primop
155 = tailCallPrimOp primop args
158 = getArgAmodes args `thenFC` \ arg_amodes ->
160 case (getPrimOpResultInfo primop) of
163 let result_amode = CReg (dataReturnConvPrim kind) in
165 (COpStmt [result_amode] op arg_amodes [{-no vol_regs-}])
166 (mkPrimReturnCode (text "primapp)" <+> ppr x))
168 -- otherwise, must be returning an enumerated type (eg. Bool).
169 -- we've only got the tag in R2, so we have to load the constructor
173 | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty
175 | isEnumerationTyCon tycon ->
177 (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}])
179 absC (CAssign (CReg node) closure_lbl) `thenC`
180 mkDynamicAlgReturnCode tycon dyn_tag sequel)
183 -- Pull a unique out of thin air to put the tag in.
184 -- It shouldn't matter if this overlaps with anything - we're
185 -- about to return anyway.
186 dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
188 closure_lbl = CVal (CIndex
189 (CLbl (mkClosureTblLabel tycon) PtrRep)
190 dyn_tag PtrRep) PtrRep
194 %********************************************************
196 %* Case expressions *
198 %********************************************************
199 Case-expression conversion is complicated enough to have its own
203 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
204 = cgCase expr live_vars save_vars bndr srt alt_type alts
208 %********************************************************
212 %********************************************************
213 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
216 cgExpr (StgLet (StgNonRec name rhs) expr)
217 = cgRhs name rhs `thenFC` \ (name, info) ->
218 addBindC name info `thenC`
221 cgExpr (StgLet (StgRec pairs) expr)
222 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
223 listFCs [ cgRhs b e | (b,e) <- pairs ]
224 ) `thenFC` \ new_bindings ->
226 addBindsC new_bindings `thenC`
231 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
232 = -- Figure out what volatile variables to save
233 nukeDeadBindings live_in_whole_let `thenC`
234 saveVolatileVarsAndRegs live_in_rhss
235 `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
237 -- TEMP: put back in for line-by-line compatibility
238 -- Doesn't look right; surely should restore in the branch!
239 -- And the code isn't used....
240 restoreCurrentCostCentre maybe_cc_slot `thenFC` \ restore_cc ->
242 -- Save those variables right now!
243 absC save_assts `thenC`
245 -- Produce code for the rhss
246 -- and add suitable bindings to the environment
247 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
250 setEndOfBlockInfo rhs_eob_info (cgExpr body)
254 %********************************************************
258 %********************************************************
260 SCC expressions are treated specially. They set the current cost
263 cgExpr (StgSCC cc expr)
264 = ASSERT(sccAbleCostCentre cc)
267 [mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)]
272 ToDo: counting of dict sccs ...
274 %********************************************************
276 %* Non-top-level bindings *
278 %********************************************************
279 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
281 We rely on the support code in @CgCon@ (to do constructors) and
282 in @CgClosure@ (to do closures).
285 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
286 -- the Id is passed along so a binding can be set up
288 cgRhs name (StgRhsCon maybe_cc con args)
289 = getArgAmodes args `thenFC` \ amodes ->
290 buildDynCon name maybe_cc con amodes `thenFC` \ idinfo ->
291 returnFC (name, idinfo)
293 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
294 = mkRhsClosure name cc bi srt fvs upd_flag args body
297 mkRhsClosure looks for two special forms of the right-hand side:
301 If neither happens, it just calls mkClosureLFInfo. You might think
302 that mkClosureLFInfo should do all this, but it seems wrong for the
303 latter to look at the structure of an expression
307 We look at the body of the closure to see if it's a selector---turgid,
308 but nothing deep. We are looking for a closure of {\em exactly} the
311 ... = [the_fv] \ u [] ->
313 con a_1 ... a_n -> a_i
317 mkRhsClosure bndr cc bi srt
318 [the_fv] -- Just one free var
319 upd_flag -- Updatable thunk
321 body@(StgCase (StgApp scrutinee [{-no args-}])
322 _ _ _ _ -- ignore uniq, etc.
324 [(DataAlt con, params, use_mask,
325 (StgApp selectee [{-no args-}]))])
326 | the_fv == scrutinee -- Scrutinee is the only free variable
327 && maybeToBool maybe_offset -- Selectee is a component of the tuple
328 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
329 = -- NOT TRUE: ASSERT(is_single_constructor)
330 -- The simplifier may have statically determined that the single alternative
331 -- is the only possible case and eliminated the others, even if there are
332 -- other constructors in the datatype. It's still ok to make a selector
333 -- thunk in this case, because we *know* which constructor the scrutinee
335 cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
337 lf_info = mkSelectorLFInfo bndr offset_into_int (isUpdatable upd_flag)
338 (_, params_w_offsets) = layOutDynConstr con idPrimRep params
339 -- Just want the layout
340 maybe_offset = assocMaybe params_w_offsets selectee
341 Just the_offset = maybe_offset
342 offset_into_int = the_offset - fixedHdrSize
348 A more generic AP thunk of the form
350 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
352 A set of these is compiled statically into the RTS, so we just use
353 those. We could extend the idea to thunks where some of the x_i are
354 global ids (and hence not free variables), but this would entail
355 generating a larger thunk. It might be an option for non-optimising
358 We only generate an Ap thunk if all the free variables are pointers,
359 for semi-obvious reasons.
362 mkRhsClosure bndr cc bi srt
365 [] -- No args; a thunk
366 body@(StgApp fun_id args)
368 | args `lengthIs` (arity-1)
369 && all isFollowableRep (map idPrimRep fvs)
370 && isUpdatable upd_flag
371 && arity <= mAX_SPEC_AP_SIZE
374 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
377 lf_info = mkApLFInfo bndr upd_flag arity
378 -- the payload has to be in the correct order, hence we can't
380 payload = StgVarArg fun_id : args
387 mkRhsClosure bndr cc bi srt fvs upd_flag args body
388 = cgRhsClosure bndr cc bi srt fvs args body lf_info
390 lf_info = mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
394 %********************************************************
396 %* Let-no-escape bindings
398 %********************************************************
400 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
401 (StgNonRec binder rhs)
402 = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot
403 NonRecursive binder rhs
404 `thenFC` \ (binder, info) ->
407 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
408 = fixC (\ new_bindings ->
409 addBindsC new_bindings `thenC`
410 listFCs [ cgLetNoEscapeRhs full_live_in_rhss
411 rhs_eob_info maybe_cc_slot Recursive b e
413 ) `thenFC` \ new_bindings ->
415 addBindsC new_bindings
417 -- We add the binders to the live-in-rhss set so that we don't
418 -- delete the bindings for the binder from the environment!
419 full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
422 :: StgLiveVars -- Live in rhss
424 -> Maybe VirtualSpOffset
428 -> FCode (Id, CgIdInfo)
430 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
431 (StgRhsClosure cc bi _ upd_flag srt args body)
432 = -- We could check the update flag, but currently we don't switch it off
433 -- for let-no-escaped things, so we omit the check too!
435 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
436 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
437 cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
438 maybe_cc_slot rec args body
440 -- For a constructor RHS we want to generate a single chunk of code which
441 -- can be jumped to from many places, which will return the constructor.
442 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
443 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
444 (StgRhsCon cc con args)
445 = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
446 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
447 [] --No args; the binder is data structure, not a function
451 Little helper for primitives that return unboxed tuples.
455 primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
456 primRetUnboxedTuple op args res_ty
457 = getArgAmodes args `thenFC` \ arg_amodes1 ->
459 For a foreign call, we might need to fiddle with some of the args:
460 for example, when passing a ByteArray#, we pass a ptr to the goods
461 rather than the heap object.
465 | StgFCallOp{} <- op = zipWith shimFCallArg args arg_amodes1
466 | otherwise = arg_amodes1
469 put all the arguments in temporaries so they don't get stomped when
470 we push the return address.
474 arg_uniqs = map mkBuiltinUnique [0 .. n_args-1]
475 arg_reps = map getAmodeRep arg_amodes
476 arg_temps = zipWith CTemp arg_uniqs arg_reps
478 absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC`
480 allocate some temporaries for the return values.
483 ty_args = tyConAppArgs (repType res_ty)
484 prim_reps = map typePrimRep ty_args
485 temp_uniqs = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1]
486 temp_amodes = zipWith CTemp temp_uniqs prim_reps
488 ccallReturnUnboxedTuple temp_amodes
489 (absC (COpStmt temp_amodes op arg_temps []))
492 shimFCallArg arg amode
493 | tycon == foreignObjPrimTyCon
494 = CMacroExpr AddrRep ForeignObj_CLOSURE_DATA [amode]
495 | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
496 = CMacroExpr PtrRep PTRS_ARR_CTS [amode]
497 | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
498 = CMacroExpr AddrRep BYTE_ARR_CTS [amode]
501 -- should be a tycon app, since this is a foreign call
502 tycon = tyConAppTyCon (repType (stgArgType arg))