2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgExpr.lhs,v 1.60 2004/09/30 10:35:43 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 SMRep ( fixedHdrSize, isFollowableArg, CgRep(..), argMachRep,
22 nonVoidArg, idCgRep, typeCgRep, typeHint,
24 import CoreSyn ( AltCon(..) )
25 import CgProf ( emitSetCCC )
26 import CgHeapery ( layOutDynConstr )
27 import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo,
28 nukeDeadBindings, addBindC, addBindsC )
29 import CgCase ( cgCase, saveVolatileVarsAndRegs )
30 import CgClosure ( cgRhsClosure, cgStdRhsClosure )
31 import CgCon ( buildDynCon, cgReturnDataCon )
32 import CgLetNoEscape ( cgLetNoEscapeClosure )
33 import CgCallConv ( dataReturnConvPrim )
35 import CgInfoTbls ( emitDirectReturnInstr )
36 import CgForeignCall ( emitForeignCall, shimForeignCallArg )
37 import CgPrimOp ( cgPrimOp )
38 import CgUtils ( addIdReps, newTemp, assignTemp, cgLit, tagToClosure )
39 import ClosureInfo ( mkSelectorLFInfo, mkApLFInfo )
40 import Cmm ( CmmExpr(..), CmmStmt(..), CmmReg, nodeReg )
41 import MachOp ( wordRep, MachHint )
43 import Literal ( literalType )
44 import PrimOp ( primOpOutOfLine, getPrimOpResultInfo,
45 PrimOp(..), PrimOpResultInfo(..) )
47 import TyCon ( isUnboxedTupleTyCon, isEnumerationTyCon )
48 import Type ( Type, tyConAppArgs, tyConAppTyCon, repType,
50 import Maybes ( maybeToBool )
51 import ListSetOps ( assocMaybe )
52 import BasicTypes ( RecFlag(..) )
53 import Util ( lengthIs )
57 This module provides the support code for @StgToAbstractC@ to deal
58 with STG {\em expressions}. See also @CgClosure@, which deals
59 with closures, and @CgCon@, which deals with constructors.
62 cgExpr :: StgExpr -- input
66 %********************************************************
70 %********************************************************
72 ``Applications'' mean {\em tail calls}, a service provided by module
73 @CgTailCall@. This includes literals, which show up as
74 @(STGApp (StgLitArg 42) [])@.
77 cgExpr (StgApp fun args) = cgTailCall fun args
80 %********************************************************
82 %* STG ConApps (for inline versions) *
84 %********************************************************
87 cgExpr (StgConApp con args)
88 = do { amodes <- getArgAmodes args
89 ; cgReturnDataCon con amodes }
92 Literals are similar to constructors; they return by putting
93 themselves in an appropriate register and returning to the address on
98 = do { cmm_lit <- cgLit lit
99 ; performPrimReturn rep (CmmLit cmm_lit) }
101 rep = typeCgRep (literalType lit)
105 %********************************************************
107 %* PrimOps and foreign calls.
109 %********************************************************
111 NOTE about "safe" foreign calls: a safe foreign call is never compiled
112 inline in a case expression. When we see
114 case (ccall ...) of { ... }
116 We generate a proper return address for the alternatives and push the
117 stack frame before doing the call, so that in the event that the call
118 re-enters the RTS the stack is in a sane state.
121 cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
123 First, copy the args into temporaries. We're going to push
124 a return address right before doing the call, so the args
125 must be out of the way.
127 reps_n_amodes <- getArgAmodes stg_args
129 -- Get the *non-void* args, and jiggle them with shimForeignCall
130 arg_exprs = [ shimForeignCallArg stg_arg expr
131 | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
135 arg_tmps <- mapM assignTemp arg_exprs
137 arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
140 Now, allocate some result regs.
142 (res_reps,res_regs,res_hints) <- newUnboxedTupleRegs res_ty
143 ccallReturnUnboxedTuple (zip res_reps (map CmmReg res_regs)) $
144 emitForeignCall (zip res_regs res_hints) fcall
145 arg_hints emptyVarSet{-no live vars-}
147 -- tagToEnum# is special: we need to pull the constructor out of the table,
148 -- and perform an appropriate return.
150 cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
151 = ASSERT(isEnumerationTyCon tycon)
152 do { (_,amode) <- getArgAmode arg
153 ; amode' <- assignTemp amode -- We're going to use it twice,
154 -- so save in a temp if non-trivial
155 ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
156 ; performReturn (emitAlgReturnCode tycon amode') }
158 -- If you're reading this code in the attempt to figure
159 -- out why the compiler panic'ed here, it is probably because
160 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
161 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
163 tycon = tyConAppTyCon res_ty
166 cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
167 | primOpOutOfLine primop
168 = tailCallPrimOp primop args
170 | ReturnsPrim VoidRep <- result_info
171 = do cgPrimOp [] primop args emptyVarSet
172 performReturn emitDirectReturnInstr
174 | ReturnsPrim rep <- result_info
175 = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)]
176 primop args emptyVarSet
177 performReturn emitDirectReturnInstr
179 | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
180 = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
181 cgPrimOp regs primop args emptyVarSet{-no live vars-}
182 returnUnboxedTuple (zip reps (map CmmReg regs))
184 | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
185 -- c.f. cgExpr (...TagToEnumOp...)
186 = do tag_reg <- newTemp wordRep
187 cgPrimOp [tag_reg] primop args emptyVarSet
188 stmtC (CmmAssign nodeReg (tagToClosure tycon (CmmReg tag_reg)))
189 performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
191 result_info = getPrimOpResultInfo primop
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 = do { -- Figure out what volatile variables to save
233 ; nukeDeadBindings live_in_whole_let
234 ; (save_assts, rhs_eob_info, maybe_cc_slot)
235 <- saveVolatileVarsAndRegs live_in_rhss
237 -- Save those variables right now!
238 ; emitStmts save_assts
240 -- Produce code for the rhss
241 -- and add suitable bindings to the environment
242 ; cgLetNoEscapeBindings live_in_rhss rhs_eob_info
243 maybe_cc_slot bindings
246 ; setEndOfBlockInfo rhs_eob_info (cgExpr body) }
250 %********************************************************
254 %********************************************************
256 SCC expressions are treated specially. They set the current cost
260 cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
263 %********************************************************
265 %* Non-top-level bindings *
267 %********************************************************
268 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
270 We rely on the support code in @CgCon@ (to do constructors) and
271 in @CgClosure@ (to do closures).
274 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
275 -- the Id is passed along so a binding can be set up
277 cgRhs name (StgRhsCon maybe_cc con args)
278 = do { amodes <- getArgAmodes args
279 ; idinfo <- buildDynCon name maybe_cc con amodes
280 ; returnFC (name, idinfo) }
282 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
283 = mkRhsClosure name cc bi srt fvs upd_flag args body
286 mkRhsClosure looks for two special forms of the right-hand side:
290 If neither happens, it just calls mkClosureLFInfo. You might think
291 that mkClosureLFInfo should do all this, but it seems wrong for the
292 latter to look at the structure of an expression
296 We look at the body of the closure to see if it's a selector---turgid,
297 but nothing deep. We are looking for a closure of {\em exactly} the
300 ... = [the_fv] \ u [] ->
302 con a_1 ... a_n -> a_i
306 mkRhsClosure bndr cc bi srt
307 [the_fv] -- Just one free var
308 upd_flag -- Updatable thunk
310 body@(StgCase (StgApp scrutinee [{-no args-}])
311 _ _ _ _ -- ignore uniq, etc.
313 [(DataAlt con, params, use_mask,
314 (StgApp selectee [{-no args-}]))])
315 | the_fv == scrutinee -- Scrutinee is the only free variable
316 && maybeToBool maybe_offset -- Selectee is a component of the tuple
317 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
318 = -- NOT TRUE: ASSERT(is_single_constructor)
319 -- The simplifier may have statically determined that the single alternative
320 -- is the only possible case and eliminated the others, even if there are
321 -- other constructors in the datatype. It's still ok to make a selector
322 -- thunk in this case, because we *know* which constructor the scrutinee
324 cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
326 lf_info = mkSelectorLFInfo bndr offset_into_int (isUpdatable upd_flag)
327 (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
328 -- Just want the layout
329 maybe_offset = assocMaybe params_w_offsets selectee
330 Just the_offset = maybe_offset
331 offset_into_int = the_offset - fixedHdrSize
337 A more generic AP thunk of the form
339 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
341 A set of these is compiled statically into the RTS, so we just use
342 those. We could extend the idea to thunks where some of the x_i are
343 global ids (and hence not free variables), but this would entail
344 generating a larger thunk. It might be an option for non-optimising
347 We only generate an Ap thunk if all the free variables are pointers,
348 for semi-obvious reasons.
351 mkRhsClosure bndr cc bi srt
354 [] -- No args; a thunk
355 body@(StgApp fun_id args)
357 | args `lengthIs` (arity-1)
358 && all isFollowableArg (map idCgRep fvs)
359 && isUpdatable upd_flag
360 && arity <= mAX_SPEC_AP_SIZE
363 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
366 lf_info = mkApLFInfo bndr upd_flag arity
367 -- the payload has to be in the correct order, hence we can't
369 payload = StgVarArg fun_id : args
376 mkRhsClosure bndr cc bi srt fvs upd_flag args body
377 = cgRhsClosure bndr cc bi srt fvs upd_flag args body
381 %********************************************************
383 %* Let-no-escape bindings
385 %********************************************************
387 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
388 (StgNonRec binder rhs)
389 = do { (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info
391 NonRecursive binder rhs
392 ; addBindC binder info }
394 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
395 = do { new_bindings <- fixC (\ new_bindings -> do
396 { addBindsC new_bindings
397 ; listFCs [ cgLetNoEscapeRhs full_live_in_rhss
398 rhs_eob_info maybe_cc_slot Recursive b e
399 | (b,e) <- pairs ] })
401 ; addBindsC new_bindings }
403 -- We add the binders to the live-in-rhss set so that we don't
404 -- delete the bindings for the binder from the environment!
405 full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
408 :: StgLiveVars -- Live in rhss
410 -> Maybe VirtualSpOffset
414 -> FCode (Id, CgIdInfo)
416 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
417 (StgRhsClosure cc bi _ upd_flag srt args body)
418 = -- We could check the update flag, but currently we don't switch it off
419 -- for let-no-escaped things, so we omit the check too!
421 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
422 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
423 cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
424 maybe_cc_slot rec args body
426 -- For a constructor RHS we want to generate a single chunk of code which
427 -- can be jumped to from many places, which will return the constructor.
428 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
429 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
430 (StgRhsCon cc con args)
431 = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
432 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
433 [] --No args; the binder is data structure, not a function
437 Little helper for primitives that return unboxed tuples.
440 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [CmmReg], [MachHint])
441 newUnboxedTupleRegs res_ty =
443 ty_args = tyConAppArgs (repType res_ty)
444 (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
445 let rep = typeCgRep ty,
448 regs <- mapM (newTemp . argMachRep) reps
449 return (reps,regs,hints)