2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgExpr.lhs,v 1.49 2002/06/18 13:58:23 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 )
22 import CLabel ( mkClosureTblLabel )
24 import SMRep ( fixedHdrSize )
25 import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo,
26 nukeDeadBindings, addBindC, addBindsC )
27 import CgCase ( cgCase, saveVolatileVarsAndRegs,
28 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, returnUnboxedTuple
37 import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo,
38 mkApLFInfo, layOutDynConstr )
39 import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
40 import Id ( idPrimRep, idType, Id )
42 import PrimOp ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) )
43 import PrimRep ( PrimRep(..), isFollowableRep )
44 import TyCon ( isUnboxedTupleTyCon, isEnumerationTyCon )
45 import Type ( Type, typePrimRep, tyConAppArgs, tyConAppTyCon, repType )
46 import Maybes ( maybeToBool )
47 import ListSetOps ( assocMaybe )
48 import Unique ( mkBuiltinUnique )
49 import BasicTypes ( TopLevelFlag(..), RecFlag(..) )
50 import Util ( lengthIs )
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 :: StgExpr -- 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 (StgLitArg 42) [])@.
74 cgExpr (StgApp fun args) = cgTailCall fun args
77 %********************************************************
79 %* STG ConApps (for inline versions) *
81 %********************************************************
84 cgExpr (StgConApp con args)
85 = getArgAmodes args `thenFC` \ amodes ->
86 cgReturnDataCon con amodes
89 Literals are similar to constructors; they return by putting
90 themselves in an appropriate register and returning to the address on
95 = performPrimReturn (text "literal" <+> ppr lit) (CLit lit)
99 %********************************************************
101 %* STG PrimApps (unboxed primitive ops) *
103 %********************************************************
105 Here is where we insert real live machine instructions.
107 NOTE about _ccall_GC_:
109 A _ccall_GC_ is treated as an out-of-line primop (returns True
110 for primOpOutOfLine) so that when we see the call in case context
111 case (ccall ...) of { ... }
112 we get a proper stack frame on the stack when we perform it. When we
113 get in a tail-call position, however, we need to actually perform the
114 call, so we treat it as an inline primop.
117 cgExpr (StgOpApp op@(StgFCallOp _ _) args res_ty)
118 = primRetUnboxedTuple op args res_ty
120 -- tagToEnum# is special: we need to pull the constructor out of the table,
121 -- and perform an appropriate return.
123 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
124 = ASSERT(isEnumerationTyCon tycon)
125 getArgAmode arg `thenFC` \amode ->
126 -- save the tag in a temporary in case amode overlaps
128 absC (CAssign dyn_tag amode) `thenC`
132 (CLbl (mkClosureTblLabel tycon) PtrRep)
133 dyn_tag PtrRep) PtrRep))
134 (\ sequel -> mkDynamicAlgReturnCode tycon dyn_tag sequel)
136 dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
138 -- if you're reading this code in the attempt to figure
139 -- out why the compiler panic'ed here, it is probably because
140 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
141 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
145 tycon = tyConAppTyCon res_ty
148 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
149 | primOpOutOfLine primop
150 = tailCallPrimOp primop args
153 = getArgAmodes args `thenFC` \ arg_amodes ->
155 case (getPrimOpResultInfo primop) of
158 let result_amode = CReg (dataReturnConvPrim kind) in
160 (COpStmt [result_amode] op arg_amodes [{-no vol_regs-}])
161 (mkPrimReturnCode (text "primapp)" <+> ppr x))
163 -- otherwise, must be returning an enumerated type (eg. Bool).
164 -- we've only got the tag in R2, so we have to load the constructor
168 | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty
170 | isEnumerationTyCon tycon ->
172 (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}])
174 absC (CAssign (CReg node) closure_lbl) `thenC`
175 mkDynamicAlgReturnCode tycon dyn_tag sequel)
178 -- Pull a unique out of thin air to put the tag in.
179 -- It shouldn't matter if this overlaps with anything - we're
180 -- about to return anyway.
181 dyn_tag = CTemp (mkBuiltinUnique 0) IntRep
183 closure_lbl = CVal (CIndex
184 (CLbl (mkClosureTblLabel tycon) PtrRep)
185 dyn_tag PtrRep) PtrRep
189 %********************************************************
191 %* Case expressions *
193 %********************************************************
194 Case-expression conversion is complicated enough to have its own
198 cgExpr (StgCase expr live_vars save_vars bndr srt alts)
199 = cgCase expr live_vars save_vars bndr srt alts
203 %********************************************************
207 %********************************************************
208 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
211 cgExpr (StgLet (StgNonRec srt name rhs) expr)
212 = cgRhs srt name rhs `thenFC` \ (name, info) ->
213 addBindC name info `thenC`
216 cgExpr (StgLet (StgRec srt pairs) expr)
217 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
218 listFCs [ cgRhs srt b e | (b,e) <- pairs ]
219 ) `thenFC` \ new_bindings ->
221 addBindsC new_bindings `thenC`
226 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
227 = -- Figure out what volatile variables to save
228 nukeDeadBindings live_in_whole_let `thenC`
229 saveVolatileVarsAndRegs live_in_rhss
230 `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) ->
231 -- ToDo: cost centre???
232 restoreCurrentCostCentre maybe_cc_slot `thenFC` \ restore_cc ->
234 -- Save those variables right now!
235 absC save_assts `thenC`
237 -- Produce code for the rhss
238 -- and add suitable bindings to the environment
239 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot bindings `thenC`
242 setEndOfBlockInfo rhs_eob_info (cgExpr body)
246 %********************************************************
250 %********************************************************
252 SCC expressions are treated specially. They set the current cost
255 cgExpr (StgSCC cc expr)
256 = ASSERT(sccAbleCostCentre cc)
259 [mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)]
264 ToDo: counting of dict sccs ...
266 %********************************************************
268 %* Non-top-level bindings *
270 %********************************************************
271 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
273 We rely on the support code in @CgCon@ (to do constructors) and
274 in @CgClosure@ (to do closures).
277 cgRhs :: SRT -> Id -> StgRhs -> FCode (Id, CgIdInfo)
278 -- the Id is passed along so a binding can be set up
280 cgRhs srt name (StgRhsCon maybe_cc con args)
281 = getArgAmodes args `thenFC` \ amodes ->
282 buildDynCon name maybe_cc con amodes `thenFC` \ idinfo ->
283 returnFC (name, idinfo)
285 cgRhs srt name (StgRhsClosure cc bi fvs upd_flag args body)
286 = mkRhsClosure name cc bi srt fvs upd_flag args body
289 mkRhsClosure looks for two special forms of the right-hand side:
293 If neither happens, it just calls mkClosureLFInfo. You might think
294 that mkClosureLFInfo should do all this, but it seems wrong for the
295 latter to look at the structure of an expression
299 We look at the body of the closure to see if it's a selector---turgid,
300 but nothing deep. We are looking for a closure of {\em exactly} the
303 ... = [the_fv] \ u [] ->
305 con a_1 ... a_n -> a_i
309 mkRhsClosure bndr cc bi srt
310 [the_fv] -- Just one free var
311 upd_flag -- Updatable thunk
313 body@(StgCase (StgApp scrutinee [{-no args-}])
314 _ _ _ _ -- ignore uniq, etc.
315 (StgAlgAlts (Just tycon)
316 [(con, params, use_mask,
317 (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 (idType bndr) offset_into_int
331 (isUpdatable upd_flag)
332 (_, params_w_offsets) = layOutDynConstr bogus_name con idPrimRep params
333 -- Just want the layout
334 maybe_offset = assocMaybe params_w_offsets selectee
335 Just the_offset = maybe_offset
336 offset_into_int = the_offset - fixedHdrSize
337 bogus_name = panic "mkRhsClosure"
343 A more generic AP thunk of the form
345 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
347 A set of these is compiled statically into the RTS, so we just use
348 those. We could extend the idea to thunks where some of the x_i are
349 global ids (and hence not free variables), but this would entail
350 generating a larger thunk. It might be an option for non-optimising
353 We only generate an Ap thunk if all the free variables are pointers,
354 for semi-obvious reasons.
357 mkRhsClosure bndr cc bi srt
360 [] -- No args; a thunk
361 body@(StgApp fun_id args)
363 | args `lengthIs` (arity-1)
364 && all isFollowableRep (map idPrimRep fvs)
365 && isUpdatable upd_flag
366 && arity <= mAX_SPEC_AP_SIZE
369 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
372 lf_info = mkApLFInfo (idType bndr) upd_flag arity
373 -- the payload has to be in the correct order, hence we can't
375 payload = StgVarArg fun_id : args
382 mkRhsClosure bndr cc bi srt fvs upd_flag args body
383 = cgRhsClosure bndr cc bi srt fvs args body lf_info
385 lf_info = mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
389 %********************************************************
391 %* Let-no-escape bindings
393 %********************************************************
395 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
396 (StgNonRec srt binder rhs)
397 = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot
398 NonRecursive srt binder rhs
399 `thenFC` \ (binder, info) ->
402 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
404 = fixC (\ new_bindings ->
405 addBindsC new_bindings `thenC`
406 listFCs [ cgLetNoEscapeRhs full_live_in_rhss
407 rhs_eob_info maybe_cc_slot Recursive srt b e
409 ) `thenFC` \ new_bindings ->
411 addBindsC new_bindings
413 -- We add the binders to the live-in-rhss set so that we don't
414 -- delete the bindings for the binder from the environment!
415 full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
418 :: StgLiveVars -- Live in rhss
420 -> Maybe VirtualSpOffset
425 -> FCode (Id, CgIdInfo)
427 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec srt binder
428 (StgRhsClosure cc bi _ upd_flag args body)
429 = -- We could check the update flag, but currently we don't switch it off
430 -- for let-no-escaped things, so we omit the check too!
432 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
433 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
434 cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
435 maybe_cc_slot rec args body
437 -- For a constructor RHS we want to generate a single chunk of code which
438 -- can be jumped to from many places, which will return the constructor.
439 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
440 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec srt binder
441 (StgRhsCon cc con args)
442 = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} srt
443 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
444 [] --No args; the binder is data structure, not a function
448 Little helper for primitives that return unboxed tuples.
452 primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
453 primRetUnboxedTuple op args res_ty
454 = getArgAmodes args `thenFC` \ arg_amodes ->
456 put all the arguments in temporaries so they don't get stomped when
457 we push the return address.
461 arg_uniqs = map mkBuiltinUnique [0 .. n_args-1]
462 arg_reps = map getArgPrimRep args
463 arg_temps = zipWith CTemp arg_uniqs arg_reps
465 absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC`
467 allocate some temporaries for the return values.
470 ty_args = tyConAppArgs (repType res_ty)
471 prim_reps = map typePrimRep ty_args
472 temp_uniqs = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1]
473 temp_amodes = zipWith CTemp temp_uniqs prim_reps
475 returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps []))