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"
47 This module provides the support code for @StgToAbstractC@ to deal
48 with STG {\em expressions}. See also @CgClosure@, which deals
49 with closures, and @CgCon@, which deals with constructors.
52 cgExpr :: StgExpr -- input
56 %********************************************************
60 %********************************************************
62 ``Applications'' mean {\em tail calls}, a service provided by module
63 @CgTailCall@. This includes literals, which show up as
64 @(STGApp (StgLitArg 42) [])@.
67 cgExpr (StgApp fun args) = cgTailCall fun args
70 %********************************************************
72 %* STG ConApps (for inline versions) *
74 %********************************************************
77 cgExpr (StgConApp con args)
78 = do { amodes <- getArgAmodes args
79 ; cgReturnDataCon con amodes }
82 Literals are similar to constructors; they return by putting
83 themselves in an appropriate register and returning to the address on
88 = do { cmm_lit <- cgLit lit
89 ; performPrimReturn rep (CmmLit cmm_lit) }
91 rep = (typeCgRep) (literalType lit)
95 %********************************************************
97 %* PrimOps and foreign calls.
99 %********************************************************
101 NOTE about "safe" foreign calls: a safe foreign call is never compiled
102 inline in a case expression. When we see
104 case (ccall ...) of { ... }
106 We generate a proper return address for the alternatives and push the
107 stack frame before doing the call, so that in the event that the call
108 re-enters the RTS the stack is in a sane state.
111 cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
113 First, copy the args into temporaries. We're going to push
114 a return address right before doing the call, so the args
115 must be out of the way.
117 reps_n_amodes <- getArgAmodes stg_args
119 -- Get the *non-void* args, and jiggle them with shimForeignCall
120 arg_exprs = [ (shimForeignCallArg stg_arg expr, stg_arg)
121 | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
124 arg_tmps <- sequence [
125 if isFollowableArg (typeCgRep (stgArgType stg_arg))
126 then assignPtrTemp arg
127 else assignNonPtrTemp arg
128 | (arg, stg_arg) <- arg_exprs]
129 let arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
131 Now, allocate some result regs.
133 (res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
134 ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
135 emitForeignCall (zip res_regs res_hints) fcall
136 arg_hints emptyVarSet{-no live vars-}
138 -- tagToEnum# is special: we need to pull the constructor out of the table,
139 -- and perform an appropriate return.
141 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
142 = ASSERT(isEnumerationTyCon tycon)
143 do { (rep,amode) <- getArgAmode arg
144 ; amode' <- if isFollowableArg rep
145 then assignPtrTemp amode
146 else assignNonPtrTemp amode
147 -- We're going to use it twice,
148 -- so save in a temp if non-trivial
149 ; this_pkg <- getThisPackage
150 ; stmtC (CmmAssign nodeReg (tagToClosure this_pkg tycon amode'))
151 ; performReturn emitReturnInstr }
153 -- If you're reading this code in the attempt to figure
154 -- out why the compiler panic'ed here, it is probably because
155 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
156 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
158 tycon = tyConAppTyCon res_ty
161 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
162 | primOpOutOfLine primop
163 = tailCallPrimOp primop args
165 | ReturnsPrim VoidRep <- result_info
166 = do cgPrimOp [] primop args emptyVarSet
167 performReturn emitReturnInstr
169 | ReturnsPrim rep <- result_info
170 = do res <- if isFollowableArg (typeCgRep res_ty)
171 then newPtrTemp (argMachRep (typeCgRep res_ty))
172 else newNonPtrTemp (argMachRep (typeCgRep res_ty))
173 cgPrimOp [res] primop args emptyVarSet
174 performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
176 | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
177 = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
178 cgPrimOp regs primop args emptyVarSet{-no live vars-}
179 returnUnboxedTuple (zip reps (map (CmmReg . CmmLocal) regs))
181 | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
182 -- c.f. cgExpr (...TagToEnumOp...)
183 = do tag_reg <- if isFollowableArg (typeCgRep res_ty)
184 then newPtrTemp wordRep
185 else newNonPtrTemp wordRep
186 this_pkg <- getThisPackage
187 cgPrimOp [tag_reg] primop args emptyVarSet
188 stmtC (CmmAssign nodeReg
189 (tagToClosure this_pkg tycon
190 (CmmReg (CmmLocal tag_reg))))
191 performReturn emitReturnInstr
193 result_info = getPrimOpResultInfo primop
196 %********************************************************
198 %* Case expressions *
200 %********************************************************
201 Case-expression conversion is complicated enough to have its own
205 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
206 = setSRT srt $ cgCase expr live_vars save_vars bndr alt_type alts
210 %********************************************************
214 %********************************************************
215 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
218 cgExpr (StgLet (StgNonRec name rhs) expr)
219 = cgRhs name rhs `thenFC` \ (name, info) ->
220 addBindC name info `thenC`
223 cgExpr (StgLet (StgRec pairs) expr)
224 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
225 listFCs [ cgRhs b e | (b,e) <- pairs ]
226 ) `thenFC` \ new_bindings ->
228 addBindsC new_bindings `thenC`
233 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
234 = do { -- Figure out what volatile variables to save
235 ; nukeDeadBindings live_in_whole_let
236 ; (save_assts, rhs_eob_info, maybe_cc_slot)
237 <- saveVolatileVarsAndRegs live_in_rhss
239 -- Save those variables right now!
240 ; emitStmts save_assts
242 -- Produce code for the rhss
243 -- and add suitable bindings to the environment
244 ; cgLetNoEscapeBindings live_in_rhss rhs_eob_info
245 maybe_cc_slot bindings
248 ; setEndOfBlockInfo rhs_eob_info (cgExpr body) }
252 %********************************************************
256 %********************************************************
258 SCC expressions are treated specially. They set the current cost
262 cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
265 %********************************************************
269 %********************************************************
272 cgExpr (StgTick m n expr) = do cgTickBox m n; cgExpr expr
275 %********************************************************
277 %* Non-top-level bindings *
279 %********************************************************
280 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
282 We rely on the support code in @CgCon@ (to do constructors) and
283 in @CgClosure@ (to do closures).
286 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
287 -- the Id is passed along so a binding can be set up
289 cgRhs name (StgRhsCon maybe_cc con args)
290 = do { amodes <- getArgAmodes args
291 ; idinfo <- buildDynCon name maybe_cc con amodes
292 ; returnFC (name, idinfo) }
294 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
295 = do this_pkg <- getThisPackage
296 setSRT srt $ mkRhsClosure this_pkg name cc bi fvs upd_flag args body
299 mkRhsClosure looks for two special forms of the right-hand side:
303 If neither happens, it just calls mkClosureLFInfo. You might think
304 that mkClosureLFInfo should do all this, but it seems wrong for the
305 latter to look at the structure of an expression
309 We look at the body of the closure to see if it's a selector---turgid,
310 but nothing deep. We are looking for a closure of {\em exactly} the
313 ... = [the_fv] \ u [] ->
315 con a_1 ... a_n -> a_i
319 mkRhsClosure this_pkg bndr cc bi
320 [the_fv] -- Just one free var
321 upd_flag -- Updatable thunk
323 body@(StgCase (StgApp scrutinee [{-no args-}])
324 _ _ _ srt -- ignore uniq, etc.
326 [(DataAlt con, params, use_mask,
327 (StgApp selectee [{-no args-}]))])
328 | the_fv == scrutinee -- Scrutinee is the only free variable
329 && maybeToBool maybe_offset -- Selectee is a component of the tuple
330 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
331 = -- NOT TRUE: ASSERT(is_single_constructor)
332 -- The simplifier may have statically determined that the single alternative
333 -- is the only possible case and eliminated the others, even if there are
334 -- other constructors in the datatype. It's still ok to make a selector
335 -- thunk in this case, because we *know* which constructor the scrutinee
337 setSRT srt $ cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
339 lf_info = mkSelectorLFInfo bndr offset_into_int
340 (isUpdatable upd_flag)
341 (_, params_w_offsets) = layOutDynConstr this_pkg con (addIdReps params)
342 -- Just want the layout
343 maybe_offset = assocMaybe params_w_offsets selectee
344 Just the_offset = maybe_offset
345 offset_into_int = the_offset - fixedHdrSize
351 A more generic AP thunk of the form
353 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
355 A set of these is compiled statically into the RTS, so we just use
356 those. We could extend the idea to thunks where some of the x_i are
357 global ids (and hence not free variables), but this would entail
358 generating a larger thunk. It might be an option for non-optimising
361 We only generate an Ap thunk if all the free variables are pointers,
362 for semi-obvious reasons.
365 mkRhsClosure this_pkg bndr cc bi
368 [] -- No args; a thunk
369 body@(StgApp fun_id args)
371 | args `lengthIs` (arity-1)
372 && all isFollowableArg (map idCgRep fvs)
373 && isUpdatable upd_flag
374 && arity <= mAX_SPEC_AP_SIZE
377 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
380 lf_info = mkApLFInfo bndr upd_flag arity
381 -- the payload has to be in the correct order, hence we can't
383 payload = StgVarArg fun_id : args
390 mkRhsClosure this_pkg bndr cc bi fvs upd_flag args body
391 = cgRhsClosure bndr cc bi fvs upd_flag args body
395 %********************************************************
397 %* Let-no-escape bindings
399 %********************************************************
401 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
402 (StgNonRec binder rhs)
403 = do { (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info
405 NonRecursive binder rhs
406 ; addBindC binder info }
408 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
409 = do { new_bindings <- fixC (\ new_bindings -> do
410 { addBindsC new_bindings
411 ; listFCs [ cgLetNoEscapeRhs full_live_in_rhss
412 rhs_eob_info maybe_cc_slot Recursive b e
413 | (b,e) <- pairs ] })
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 setSRT srt $ cgLetNoEscapeClosure binder cc bi 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 = setSRT NoSRT $ cgLetNoEscapeClosure binder cc noBinderInfo{-safe-}
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.
454 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [MachHint])
455 newUnboxedTupleRegs res_ty =
457 ty_args = tyConAppArgs (repType res_ty)
458 (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
459 let rep = typeCgRep ty,
461 make_new_temp rep = if isFollowableArg rep
462 then newPtrTemp (argMachRep rep)
463 else newNonPtrTemp (argMachRep rep)
465 regs <- mapM make_new_temp reps
466 return (reps,regs,hints)