2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
7 module CgExpr ( cgExpr ) where
9 #include "HsVersions.h"
46 This module provides the support code for @StgToAbstractC@ to deal
47 with STG {\em expressions}. See also @CgClosure@, which deals
48 with closures, and @CgCon@, which deals with constructors.
51 cgExpr :: StgExpr -- input
55 %********************************************************
59 %********************************************************
61 ``Applications'' mean {\em tail calls}, a service provided by module
62 @CgTailCall@. This includes literals, which show up as
63 @(STGApp (StgLitArg 42) [])@.
66 cgExpr (StgApp fun args) = cgTailCall fun args
69 %********************************************************
71 %* STG ConApps (for inline versions) *
73 %********************************************************
76 cgExpr (StgConApp con args)
77 = do { amodes <- getArgAmodes args
78 ; cgReturnDataCon con amodes }
81 Literals are similar to constructors; they return by putting
82 themselves in an appropriate register and returning to the address on
87 = do { cmm_lit <- cgLit lit
88 ; performPrimReturn rep (CmmLit cmm_lit) }
90 rep = (typeCgRep) (literalType lit)
94 %********************************************************
96 %* PrimOps and foreign calls.
98 %********************************************************
100 NOTE about "safe" foreign calls: a safe foreign call is never compiled
101 inline in a case expression. When we see
103 case (ccall ...) of { ... }
105 We generate a proper return address for the alternatives and push the
106 stack frame before doing the call, so that in the event that the call
107 re-enters the RTS the stack is in a sane state.
110 cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
112 First, copy the args into temporaries. We're going to push
113 a return address right before doing the call, so the args
114 must be out of the way.
116 reps_n_amodes <- getArgAmodes stg_args
118 -- Get the *non-void* args, and jiggle them with shimForeignCall
119 arg_exprs = [ shimForeignCallArg stg_arg expr
120 | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
124 arg_tmps <- mapM assignTemp arg_exprs
126 arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
129 Now, allocate some result regs.
131 (res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
132 ccallReturnUnboxedTuple (zip res_reps (map CmmReg res_regs)) $
133 emitForeignCall (zip res_regs res_hints) fcall
134 arg_hints emptyVarSet{-no live vars-}
136 -- tagToEnum# is special: we need to pull the constructor out of the table,
137 -- and perform an appropriate return.
139 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
140 = ASSERT(isEnumerationTyCon tycon)
141 do { (_,amode) <- getArgAmode arg
142 ; amode' <- assignTemp amode -- We're going to use it twice,
143 -- so save in a temp if non-trivial
144 ; this_pkg <- getThisPackage
145 ; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
146 ; performReturn (emitAlgReturnCode tycon amode') }
148 -- If you're reading this code in the attempt to figure
149 -- out why the compiler panic'ed here, it is probably because
150 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
151 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
153 tycon = tyConAppTyCon res_ty
156 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
157 | primOpOutOfLine primop
158 = tailCallPrimOp primop args
160 | ReturnsPrim VoidRep <- result_info
161 = do cgPrimOp [] primop args emptyVarSet
162 performReturn emitDirectReturnInstr
164 | ReturnsPrim rep <- result_info
165 = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)]
166 primop args emptyVarSet
167 performReturn emitDirectReturnInstr
169 | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
170 = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
171 cgPrimOp regs primop args emptyVarSet{-no live vars-}
172 returnUnboxedTuple (zip reps (map CmmReg regs))
174 | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
175 -- c.f. cgExpr (...TagToEnumOp...)
176 = do tag_reg <- newTemp wordRep
177 this_pkg <- getThisPackage
178 cgPrimOp [tag_reg] primop args emptyVarSet
179 stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon (CmmReg tag_reg)))
180 performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
182 result_info = getPrimOpResultInfo primop
185 %********************************************************
187 %* Case expressions *
189 %********************************************************
190 Case-expression conversion is complicated enough to have its own
194 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
195 = cgCase expr live_vars save_vars bndr srt alt_type alts
199 %********************************************************
203 %********************************************************
204 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
207 cgExpr (StgLet (StgNonRec name rhs) expr)
208 = cgRhs name rhs `thenFC` \ (name, info) ->
209 addBindC name info `thenC`
212 cgExpr (StgLet (StgRec pairs) expr)
213 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
214 listFCs [ cgRhs b e | (b,e) <- pairs ]
215 ) `thenFC` \ new_bindings ->
217 addBindsC new_bindings `thenC`
222 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
223 = do { -- Figure out what volatile variables to save
224 ; nukeDeadBindings live_in_whole_let
225 ; (save_assts, rhs_eob_info, maybe_cc_slot)
226 <- saveVolatileVarsAndRegs live_in_rhss
228 -- Save those variables right now!
229 ; emitStmts save_assts
231 -- Produce code for the rhss
232 -- and add suitable bindings to the environment
233 ; cgLetNoEscapeBindings live_in_rhss rhs_eob_info
234 maybe_cc_slot bindings
237 ; setEndOfBlockInfo rhs_eob_info (cgExpr body) }
241 %********************************************************
245 %********************************************************
247 SCC expressions are treated specially. They set the current cost
251 cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
254 %********************************************************
256 %* Non-top-level bindings *
258 %********************************************************
259 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
261 We rely on the support code in @CgCon@ (to do constructors) and
262 in @CgClosure@ (to do closures).
265 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
266 -- the Id is passed along so a binding can be set up
268 cgRhs name (StgRhsCon maybe_cc con args)
269 = do { amodes <- getArgAmodes args
270 ; idinfo <- buildDynCon name maybe_cc con amodes
271 ; returnFC (name, idinfo) }
273 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
274 = do this_pkg <- getThisPackage
275 mkRhsClosure this_pkg name cc bi srt fvs upd_flag args body
278 mkRhsClosure looks for two special forms of the right-hand side:
282 If neither happens, it just calls mkClosureLFInfo. You might think
283 that mkClosureLFInfo should do all this, but it seems wrong for the
284 latter to look at the structure of an expression
288 We look at the body of the closure to see if it's a selector---turgid,
289 but nothing deep. We are looking for a closure of {\em exactly} the
292 ... = [the_fv] \ u [] ->
294 con a_1 ... a_n -> a_i
298 mkRhsClosure this_pkg bndr cc bi srt
299 [the_fv] -- Just one free var
300 upd_flag -- Updatable thunk
302 body@(StgCase (StgApp scrutinee [{-no args-}])
303 _ _ _ _ -- ignore uniq, etc.
305 [(DataAlt con, params, use_mask,
306 (StgApp selectee [{-no args-}]))])
307 | the_fv == scrutinee -- Scrutinee is the only free variable
308 && maybeToBool maybe_offset -- Selectee is a component of the tuple
309 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
310 = -- NOT TRUE: ASSERT(is_single_constructor)
311 -- The simplifier may have statically determined that the single alternative
312 -- is the only possible case and eliminated the others, even if there are
313 -- other constructors in the datatype. It's still ok to make a selector
314 -- thunk in this case, because we *know* which constructor the scrutinee
316 cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
318 lf_info = mkSelectorLFInfo bndr offset_into_int
319 (isUpdatable upd_flag)
320 (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
321 -- Just want the layout
322 maybe_offset = assocMaybe params_w_offsets selectee
323 Just the_offset = maybe_offset
324 offset_into_int = the_offset - fixedHdrSize
330 A more generic AP thunk of the form
332 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
334 A set of these is compiled statically into the RTS, so we just use
335 those. We could extend the idea to thunks where some of the x_i are
336 global ids (and hence not free variables), but this would entail
337 generating a larger thunk. It might be an option for non-optimising
340 We only generate an Ap thunk if all the free variables are pointers,
341 for semi-obvious reasons.
344 mkRhsClosure this_pkg bndr cc bi srt
347 [] -- No args; a thunk
348 body@(StgApp fun_id args)
350 | args `lengthIs` (arity-1)
351 && all isFollowableArg (map idCgRep fvs)
352 && isUpdatable upd_flag
353 && arity <= mAX_SPEC_AP_SIZE
356 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
359 lf_info = mkApLFInfo bndr upd_flag arity
360 -- the payload has to be in the correct order, hence we can't
362 payload = StgVarArg fun_id : args
369 mkRhsClosure this_pkg bndr cc bi srt fvs upd_flag args body
370 = cgRhsClosure bndr cc bi srt fvs upd_flag args body
374 %********************************************************
376 %* Let-no-escape bindings
378 %********************************************************
380 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
381 (StgNonRec binder rhs)
382 = do { (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info
384 NonRecursive binder rhs
385 ; addBindC binder info }
387 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
388 = do { new_bindings <- fixC (\ new_bindings -> do
389 { addBindsC new_bindings
390 ; listFCs [ cgLetNoEscapeRhs full_live_in_rhss
391 rhs_eob_info maybe_cc_slot Recursive b e
392 | (b,e) <- pairs ] })
394 ; addBindsC new_bindings }
396 -- We add the binders to the live-in-rhss set so that we don't
397 -- delete the bindings for the binder from the environment!
398 full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
401 :: StgLiveVars -- Live in rhss
403 -> Maybe VirtualSpOffset
407 -> FCode (Id, CgIdInfo)
409 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
410 (StgRhsClosure cc bi _ upd_flag srt args body)
411 = -- We could check the update flag, but currently we don't switch it off
412 -- for let-no-escaped things, so we omit the check too!
414 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
415 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
416 cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
417 maybe_cc_slot rec args body
419 -- For a constructor RHS we want to generate a single chunk of code which
420 -- can be jumped to from many places, which will return the constructor.
421 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
422 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
423 (StgRhsCon cc con args)
424 = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
425 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
426 [] --No args; the binder is data structure, not a function
430 Little helper for primitives that return unboxed tuples.
433 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [CmmReg], [MachHint])
434 newUnboxedTupleRegs res_ty =
436 ty_args = tyConAppArgs (repType res_ty)
437 (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
438 let rep = typeCgRep ty,
441 regs <- mapM (newTemp . argMachRep) reps
442 return (reps,regs,hints)