2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
14 module CgExpr ( cgExpr ) where
16 #include "HsVersions.h"
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 = do { amodes <- getArgAmodes args
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 = do { cmm_lit <- cgLit lit
96 ; performPrimReturn rep (CmmLit cmm_lit) }
98 rep = (typeCgRep) (literalType lit)
102 %********************************************************
104 %* PrimOps and foreign calls.
106 %********************************************************
108 NOTE about "safe" foreign calls: a safe foreign call is never compiled
109 inline in a case expression. When we see
111 case (ccall ...) of { ... }
113 We generate a proper return address for the alternatives and push the
114 stack frame before doing the call, so that in the event that the call
115 re-enters the RTS the stack is in a sane state.
118 cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
120 First, copy the args into temporaries. We're going to push
121 a return address right before doing the call, so the args
122 must be out of the way.
124 reps_n_amodes <- getArgAmodes stg_args
126 -- Get the *non-void* args, and jiggle them with shimForeignCall
127 arg_exprs = [ (shimForeignCallArg stg_arg expr, stg_arg)
128 | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
131 arg_tmps <- sequence [
132 if isFollowableArg (typeCgRep (stgArgType stg_arg))
133 then assignPtrTemp arg
134 else assignNonPtrTemp arg
135 | (arg, stg_arg) <- arg_exprs]
136 let arg_hints = zipWith CmmHinted arg_tmps (map (typeHint.stgArgType) stg_args)
138 Now, allocate some result regs.
140 (res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
141 ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
142 emitForeignCall (zipWith CmmHinted res_regs res_hints) fcall
143 arg_hints emptyVarSet{-no live vars-}
145 -- tagToEnum# is special: we need to pull the constructor out of the table,
146 -- and perform an appropriate return.
148 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
149 = ASSERT(isEnumerationTyCon tycon)
150 do { (rep,amode) <- getArgAmode arg
151 ; amode' <- if isFollowableArg rep
152 then assignPtrTemp amode
153 else assignNonPtrTemp amode
154 -- We're going to use it twice,
155 -- so save in a temp if non-trivial
156 ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
157 ; performReturn emitReturnInstr }
159 -- If you're reading this code in the attempt to figure
160 -- out why the compiler panic'ed here, it is probably because
161 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
162 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
164 tycon = tyConAppTyCon res_ty
167 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
168 | primOpOutOfLine primop
169 = tailCallPrimOp primop args
171 | ReturnsPrim VoidRep <- result_info
172 = do cgPrimOp [] primop args emptyVarSet
173 performReturn emitReturnInstr
175 | ReturnsPrim rep <- result_info
176 = do res <- if isFollowableArg (typeCgRep res_ty)
177 then newPtrTemp (argMachRep (typeCgRep res_ty))
178 else newNonPtrTemp (argMachRep (typeCgRep res_ty))
179 cgPrimOp [res] primop args emptyVarSet
180 performPrimReturn (primRepToCgRep rep) (CmmReg (CmmLocal res))
182 | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
183 = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
184 cgPrimOp regs primop args emptyVarSet{-no live vars-}
185 returnUnboxedTuple (zip reps (map (CmmReg . CmmLocal) regs))
187 | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
188 -- c.f. cgExpr (...TagToEnumOp...)
189 = do tag_reg <- if isFollowableArg (typeCgRep res_ty)
190 then newPtrTemp wordRep
191 else newNonPtrTemp wordRep
192 cgPrimOp [tag_reg] primop args emptyVarSet
193 stmtC (CmmAssign nodeReg
195 (CmmReg (CmmLocal tag_reg))))
196 performReturn emitReturnInstr
198 result_info = getPrimOpResultInfo primop
201 %********************************************************
203 %* Case expressions *
205 %********************************************************
206 Case-expression conversion is complicated enough to have its own
210 cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
211 = setSRT srt $ cgCase expr live_vars save_vars bndr alt_type alts
215 %********************************************************
219 %********************************************************
220 \subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
223 cgExpr (StgLet (StgNonRec name rhs) expr)
224 = cgRhs name rhs `thenFC` \ (name, info) ->
225 addBindC name info `thenC`
228 cgExpr (StgLet (StgRec pairs) expr)
229 = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
230 listFCs [ cgRhs b e | (b,e) <- pairs ]
231 ) `thenFC` \ new_bindings ->
233 addBindsC new_bindings `thenC`
238 cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
239 = do { -- Figure out what volatile variables to save
240 ; nukeDeadBindings live_in_whole_let
241 ; (save_assts, rhs_eob_info, maybe_cc_slot)
242 <- saveVolatileVarsAndRegs live_in_rhss
244 -- Save those variables right now!
245 ; emitStmts save_assts
247 -- Produce code for the rhss
248 -- and add suitable bindings to the environment
249 ; cgLetNoEscapeBindings live_in_rhss rhs_eob_info
250 maybe_cc_slot bindings
253 ; setEndOfBlockInfo rhs_eob_info (cgExpr body) }
257 %********************************************************
261 %********************************************************
263 SCC expressions are treated specially. They set the current cost
267 cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
270 %********************************************************
274 %********************************************************
277 cgExpr (StgTick m n expr) = do cgTickBox m n; cgExpr expr
280 %********************************************************
282 %* Non-top-level bindings *
284 %********************************************************
285 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
287 We rely on the support code in @CgCon@ (to do constructors) and
288 in @CgClosure@ (to do closures).
291 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
292 -- the Id is passed along so a binding can be set up
294 cgRhs name (StgRhsCon maybe_cc con args)
295 = do { amodes <- getArgAmodes args
296 ; idinfo <- buildDynCon name maybe_cc con amodes
297 ; returnFC (name, idinfo) }
299 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
300 = setSRT srt $ mkRhsClosure name cc bi fvs upd_flag args body
303 mkRhsClosure looks for two special forms of the right-hand side:
307 If neither happens, it just calls mkClosureLFInfo. You might think
308 that mkClosureLFInfo should do all this, but it seems wrong for the
309 latter to look at the structure of an expression
313 We look at the body of the closure to see if it's a selector---turgid,
314 but nothing deep. We are looking for a closure of {\em exactly} the
317 ... = [the_fv] \ u [] ->
319 con a_1 ... a_n -> a_i
323 mkRhsClosure bndr cc bi
324 [the_fv] -- Just one free var
325 upd_flag -- Updatable thunk
327 body@(StgCase (StgApp scrutinee [{-no args-}])
328 _ _ _ srt -- ignore uniq, etc.
330 [(DataAlt con, params, use_mask,
331 (StgApp selectee [{-no args-}]))])
332 | the_fv == scrutinee -- Scrutinee is the only free variable
333 && maybeToBool maybe_offset -- Selectee is a component of the tuple
334 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
335 = -- NOT TRUE: ASSERT(is_single_constructor)
336 -- The simplifier may have statically determined that the single alternative
337 -- is the only possible case and eliminated the others, even if there are
338 -- other constructors in the datatype. It's still ok to make a selector
339 -- thunk in this case, because we *know* which constructor the scrutinee
341 setSRT srt $ cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
343 lf_info = mkSelectorLFInfo bndr offset_into_int
344 (isUpdatable upd_flag)
345 (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
346 -- Just want the layout
347 maybe_offset = assocMaybe params_w_offsets selectee
348 Just the_offset = maybe_offset
349 offset_into_int = the_offset - fixedHdrSize
355 A more generic AP thunk of the form
357 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
359 A set of these is compiled statically into the RTS, so we just use
360 those. We could extend the idea to thunks where some of the x_i are
361 global ids (and hence not free variables), but this would entail
362 generating a larger thunk. It might be an option for non-optimising
365 We only generate an Ap thunk if all the free variables are pointers,
366 for semi-obvious reasons.
369 mkRhsClosure bndr cc bi
372 [] -- No args; a thunk
373 body@(StgApp fun_id args)
375 | args `lengthIs` (arity-1)
376 && all isFollowableArg (map idCgRep fvs)
377 && isUpdatable upd_flag
378 && arity <= mAX_SPEC_AP_SIZE
381 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
384 lf_info = mkApLFInfo bndr upd_flag arity
385 -- the payload has to be in the correct order, hence we can't
387 payload = StgVarArg fun_id : args
394 mkRhsClosure bndr cc bi fvs upd_flag args body
395 = cgRhsClosure bndr cc bi fvs upd_flag args body
399 %********************************************************
401 %* Let-no-escape bindings
403 %********************************************************
405 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
406 (StgNonRec binder rhs)
407 = do { (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info
409 NonRecursive binder rhs
410 ; addBindC binder info }
412 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
413 = do { new_bindings <- fixC (\ new_bindings -> do
414 { addBindsC new_bindings
415 ; listFCs [ cgLetNoEscapeRhs full_live_in_rhss
416 rhs_eob_info maybe_cc_slot Recursive b e
417 | (b,e) <- pairs ] })
419 ; addBindsC new_bindings }
421 -- We add the binders to the live-in-rhss set so that we don't
422 -- delete the bindings for the binder from the environment!
423 full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
426 :: StgLiveVars -- Live in rhss
428 -> Maybe VirtualSpOffset
432 -> FCode (Id, CgIdInfo)
434 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
435 (StgRhsClosure cc bi _ upd_flag srt args body)
436 = -- We could check the update flag, but currently we don't switch it off
437 -- for let-no-escaped things, so we omit the check too!
439 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
440 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
441 setSRT srt $ cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info
442 maybe_cc_slot rec args body
444 -- For a constructor RHS we want to generate a single chunk of code which
445 -- can be jumped to from many places, which will return the constructor.
446 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
447 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
448 (StgRhsCon cc con args)
449 = setSRT NoSRT $ cgLetNoEscapeClosure binder cc noBinderInfo{-safe-}
450 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
451 [] --No args; the binder is data structure, not a function
455 Little helper for primitives that return unboxed tuples.
458 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [MachHint])
459 newUnboxedTupleRegs res_ty =
461 ty_args = tyConAppArgs (repType res_ty)
462 (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
463 let rep = typeCgRep ty,
465 make_new_temp rep = if isFollowableArg rep
466 then newPtrTemp (argMachRep rep)
467 else newNonPtrTemp (argMachRep rep)
469 regs <- mapM make_new_temp reps
470 return (reps,regs,hints)