2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgExpr.lhs,v 1.61 2004/11/26 16:20:07 simonmar 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 ; dflags <- getDynFlags
156 ; stmtC (CmmAssign nodeReg (tagToClosure dflags tycon amode'))
157 ; performReturn (emitAlgReturnCode tycon amode') }
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 emitDirectReturnInstr
175 | ReturnsPrim rep <- result_info
176 = do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)]
177 primop args emptyVarSet
178 performReturn emitDirectReturnInstr
180 | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
181 = do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
182 cgPrimOp regs primop args emptyVarSet{-no live vars-}
183 returnUnboxedTuple (zip reps (map CmmReg regs))
185 | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
186 -- c.f. cgExpr (...TagToEnumOp...)
187 = do tag_reg <- newTemp wordRep
188 dflags <- getDynFlags
189 cgPrimOp [tag_reg] primop args emptyVarSet
190 stmtC (CmmAssign nodeReg (tagToClosure dflags tycon (CmmReg tag_reg)))
191 performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
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 = cgCase expr live_vars save_vars bndr srt 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 %********************************************************
267 %* Non-top-level bindings *
269 %********************************************************
270 \subsection[non-top-level-bindings]{Converting non-top-level bindings}
272 We rely on the support code in @CgCon@ (to do constructors) and
273 in @CgClosure@ (to do closures).
276 cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
277 -- the Id is passed along so a binding can be set up
279 cgRhs name (StgRhsCon maybe_cc con args)
280 = do { amodes <- getArgAmodes args
281 ; idinfo <- buildDynCon name maybe_cc con amodes
282 ; returnFC (name, idinfo) }
284 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
285 = do dflags <- getDynFlags
286 mkRhsClosure dflags 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 dflags 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.
316 [(DataAlt con, params, use_mask,
317 (StgApp selectee [{-no args-}]))])
318 | the_fv == scrutinee -- Scrutinee is the only free variable
319 && maybeToBool maybe_offset -- Selectee is a component of the tuple
320 && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough
321 = -- NOT TRUE: ASSERT(is_single_constructor)
322 -- The simplifier may have statically determined that the single alternative
323 -- is the only possible case and eliminated the others, even if there are
324 -- other constructors in the datatype. It's still ok to make a selector
325 -- thunk in this case, because we *know* which constructor the scrutinee
327 cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
329 lf_info = mkSelectorLFInfo bndr offset_into_int
330 (isUpdatable upd_flag)
331 (_, params_w_offsets) = layOutDynConstr dflags con (addIdReps params)
332 -- Just want the layout
333 maybe_offset = assocMaybe params_w_offsets selectee
334 Just the_offset = maybe_offset
335 offset_into_int = the_offset - fixedHdrSize
341 A more generic AP thunk of the form
343 x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
345 A set of these is compiled statically into the RTS, so we just use
346 those. We could extend the idea to thunks where some of the x_i are
347 global ids (and hence not free variables), but this would entail
348 generating a larger thunk. It might be an option for non-optimising
351 We only generate an Ap thunk if all the free variables are pointers,
352 for semi-obvious reasons.
355 mkRhsClosure dflags bndr cc bi srt
358 [] -- No args; a thunk
359 body@(StgApp fun_id args)
361 | args `lengthIs` (arity-1)
362 && all isFollowableArg (map idCgRep fvs)
363 && isUpdatable upd_flag
364 && arity <= mAX_SPEC_AP_SIZE
367 = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
370 lf_info = mkApLFInfo bndr upd_flag arity
371 -- the payload has to be in the correct order, hence we can't
373 payload = StgVarArg fun_id : args
380 mkRhsClosure dflags bndr cc bi srt fvs upd_flag args body
381 = cgRhsClosure bndr cc bi srt fvs upd_flag args body
385 %********************************************************
387 %* Let-no-escape bindings
389 %********************************************************
391 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot
392 (StgNonRec binder rhs)
393 = do { (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info
395 NonRecursive binder rhs
396 ; addBindC binder info }
398 cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
399 = do { new_bindings <- fixC (\ new_bindings -> do
400 { addBindsC new_bindings
401 ; listFCs [ cgLetNoEscapeRhs full_live_in_rhss
402 rhs_eob_info maybe_cc_slot Recursive b e
403 | (b,e) <- pairs ] })
405 ; addBindsC new_bindings }
407 -- We add the binders to the live-in-rhss set so that we don't
408 -- delete the bindings for the binder from the environment!
409 full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
412 :: StgLiveVars -- Live in rhss
414 -> Maybe VirtualSpOffset
418 -> FCode (Id, CgIdInfo)
420 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
421 (StgRhsClosure cc bi _ upd_flag srt args body)
422 = -- We could check the update flag, but currently we don't switch it off
423 -- for let-no-escaped things, so we omit the check too!
425 -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update!
426 -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
427 cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
428 maybe_cc_slot rec args body
430 -- For a constructor RHS we want to generate a single chunk of code which
431 -- can be jumped to from many places, which will return the constructor.
432 -- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
433 cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
434 (StgRhsCon cc con args)
435 = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
436 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
437 [] --No args; the binder is data structure, not a function
441 Little helper for primitives that return unboxed tuples.
444 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [CmmReg], [MachHint])
445 newUnboxedTupleRegs res_ty =
447 ty_args = tyConAppArgs (repType res_ty)
448 (reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args,
449 let rep = typeCgRep ty,
452 regs <- mapM (newTemp . argMachRep) reps
453 return (reps,regs,hints)