--------------------------------------------------------------------------------- Stg to C-- code generation: expressions---- (c) The University of Glasgow 2004-2006-------------------------------------------------------------------------------{-# OPTIONS -fno-warn-tabs #-}-- The above warning supression flag is a temporary kludge.-- While working on this module you are encouraged to remove it and-- detab the module (please do the detabbing in a separate patch). See-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces-- for detailsmoduleStgCmmExpr(cgExpr)where#define FAST_STRING_NOT_NEEDED#include "HsVersions.h"import{-# SOURCE #-}StgCmmBind(cgBind)importStgCmmMonadimportStgCmmHeapimportStgCmmEnvimportStgCmmConimportStgCmmProfimportStgCmmLayoutimportStgCmmPrimimportStgCmmHpcimportStgCmmTickyimportStgCmmUtilsimportStgCmmClosureimportStgSynimportMkGraphimportBlockIdimportCmmimportCoreSynimportDataConimportForeignCallimportIdimportPrimOpimportTyConimportTypeimportCostCentre(CostCentreStack,currentCCS)importControl.Monad(when)importMaybesimportUtilimportFastStringimportOutputableimportUniqSupply-------------------------------------------------------------------------- cgExpr: the main function------------------------------------------------------------------------cgExpr::StgExpr->FCode()cgExpr(StgAppfunargs)=cgIdAppfunargs{- seq# a s ==> a -}cgExpr(StgOpApp(StgPrimOpSeqOp)[StgVarArga,_]_res_ty)=cgIdAppa[]cgExpr(StgOpAppopargsty)=cgOpAppopargstycgExpr(StgConAppconargs)=cgConAppconargscgExpr(StgSCCcctickpushexpr)=do{emitSetCCCcctickpush;cgExprexpr}cgExpr(StgTickmnexpr)=do{emit(mkTickBoxmn);cgExprexpr}cgExpr(StgLitlit)=docmm_lit<-cgLitlitemitReturn[CmmLitcmm_lit]cgExpr(StgLetbindsexpr)=do{cgBindbinds;cgExprexpr}cgExpr(StgLetNoEscape__bindsexpr)=do{us<-newUniqSupply;letjoin_id=mkBlockId(uniqFromSupplyus);cgLneBindsjoin_idbinds;cgExprexpr;emitLabeljoin_id}cgExpr(StgCaseexpr_live_vars_save_varsbndr_srtalt_typealts)=cgCaseexprbndralt_typealtscgExpr(StgLam{})=panic"cgExpr: StgLam"-------------------------------------------------------------------------- Let no escape------------------------------------------------------------------------{- Generating code for a let-no-escape binding, aka join point is very
very similar to what we do for a case expression. The duality is
between
let-no-escape x = b
in e
and
case e of ... -> b
That is, the RHS of 'x' (ie 'b') will execute *later*, just like
the alternative of the case; it needs to be compiled in an environment
in which all volatile bindings are forgotten, and the free vars are
bound only to stable things like stack locations.. The 'e' part will
execute *next*, just like the scrutinee of a case. -}-------------------------cgLneBinds::BlockId->StgBinding->FCode()cgLneBindsjoin_id(StgNonRecbndrrhs)=do{local_cc<-saveCurrentCostCentre-- See Note [Saving the current cost centre];info<-cgLetNoEscapeRhsjoin_idlocal_ccbndrrhs;addBindC(cg_idinfo)info}cgLneBindsjoin_id(StgRecpairs)=do{local_cc<-saveCurrentCostCentre;new_bindings<-fixC(\new_bindings->do{addBindsCnew_bindings;listFCs[cgLetNoEscapeRhsjoin_idlocal_ccbe|(b,e)<-pairs]});addBindsCnew_bindings}-------------------------cgLetNoEscapeRhs::BlockId-- join point for successor of let-no-escape->MaybeLocalReg-- Saved cost centre->Id->StgRhs->FCodeCgIdInfocgLetNoEscapeRhsjoin_idlocal_ccbndrrhs=do{(info,rhs_body)<-getCodeR$cgLetNoEscapeRhsBodylocal_ccbndrrhs;let(bid,_)=expectJust"cgLetNoEscapeRhs"$maybeLetNoEscapeinfo;emitOutOfLinebid$rhs_body<*>mkBranchjoin_id;returninfo}cgLetNoEscapeRhsBody::MaybeLocalReg-- Saved cost centre->Id->StgRhs->FCodeCgIdInfocgLetNoEscapeRhsBodylocal_ccbndr(StgRhsClosurecc_bi__upd_argsbody)=cgLetNoEscapeClosurebndrlocal_cccc(nonVoidIdsargs)bodycgLetNoEscapeRhsBodylocal_ccbndr(StgRhsConccconargs)=cgLetNoEscapeClosurebndrlocal_cccc[](StgConAppconargs)-- For a constructor RHS we want to generate a single chunk of -- code which can be jumped to from many places, which will -- return the constructor. It's easy; just behave as if it -- was an StgRhsClosure with a ConApp inside!-------------------------cgLetNoEscapeClosure::Id-- binder->MaybeLocalReg-- Slot for saved current cost centre->CostCentreStack-- XXX: *** NOT USED *** why not?->[NonVoidId]-- Args (as in \ args -> body)->StgExpr-- Body (as in above)->FCodeCgIdInfocgLetNoEscapeClosurebndrcc_slot_unused_ccargsbody=do{arg_regs<-forkProc$do{restoreCurrentCostCentrecc_slot;arg_regs<-bindArgsToRegsargs;altHeapCheckarg_regs(cgExprbody)-- Using altHeapCheck just reduces-- instructions to save on stack;returnarg_regs};return$lneIdInfobndrarg_regs}-------------------------------------------------------------------------- Case expressions------------------------------------------------------------------------{- Note [Compiling case expressions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It is quite interesting to decide whether to put a heap-check at the
start of each alternative. Of course we certainly have to do so if
the case forces an evaluation, or if there is a primitive op which can
trigger GC.
A more interesting situation is this (a Plan-B situation)
!P!;
...P...
case x# of
0# -> !Q!; ...Q...
default -> !R!; ...R...
where !x! indicates a possible heap-check point. The heap checks
in the alternatives *can* be omitted, in which case the topmost
heapcheck will take their worst case into account.
In favour of omitting !Q!, !R!:
- *May* save a heap overflow test,
if ...P... allocates anything.
- We can use relative addressing from a single Hp to
get at all the closures so allocated.
- No need to save volatile vars etc across heap checks
in !Q!, !R!
Against omitting !Q!, !R!
- May put a heap-check into the inner loop. Suppose
the main loop is P -> R -> P -> R...
Q is the loop exit, and only it does allocation.
This only hurts us if P does no allocation. If P allocates,
then there is a heap check in the inner loop anyway.
- May do more allocation than reqd. This sometimes bites us
badly. For example, nfib (ha!) allocates about 30\% more space if the
worst-casing is done, because many many calls to nfib are leaf calls
which don't need to allocate anything.
We can un-allocate, but that costs an instruction
Neither problem hurts us if there is only one alternative.
Suppose the inner loop is P->R->P->R etc. Then here is
how many heap checks we get in the *inner loop* under various
conditions
Alooc Heap check in branches (!Q!, !R!)?
P Q R yes no (absorb to !P!)
--------------------------------------
n n n 0 0
n y n 0 1
n . y 1 1
y . y 2 1
y . n 1 1
Best choices: absorb heap checks from Q and R into !P! iff
a) P itself does some allocation
or
b) P does allocation, or there is exactly one alternative
We adopt (b) because that is more likely to put the heap check at the
entry to a function, when not many things are live. After a bunch of
single-branch cases, we may have lots of things live
Hence: two basic plans for
case e of r { alts }
------ Plan A: the general case ---------
...save current cost centre...
...code for e,
with sequel (SetLocals r)
...restore current cost centre...
...code for alts...
...alts do their own heap checks
------ Plan B: special case when ---------
(i) e does not allocate or call GC
(ii) either upstream code performs allocation
or there is just one alternative
Then heap allocation in the (single) case branch
is absorbed by the upstream check.
Very common example: primops on unboxed values
...code for e,
with sequel (SetLocals r)...
...code for alts...
...no heap check...
-}-------------------------------------dataGcPlan=GcInAlts-- Put a GC check at the start the case alternatives,[LocalReg]-- which binds these registers|NoGcInAlts-- The scrutinee is a primitive value, or a call to a-- primitive op which does no GC. Absorb the allocation-- of the case alternative(s) into the upstream check-------------------------------------cgCase::StgExpr->Id->AltType->[StgAlt]->FCode()cgCase(StgOpApp(StgPrimOpop)args_)bndr(AlgAlttycon)alts|isEnumerationTyContycon-- Note [case on bool]=do{tag_expr<-do_enum_primopopargs-- If the binder is not dead, convert the tag to a constructor-- and assign it.;when(not(isDeadBinderbndr))$do{tmp_reg<-bindArgToReg(NonVoidbndr);emitAssign(CmmLocaltmp_reg)(tagToClosuretycontag_expr)};(mb_deflt,branches)<-cgAlgAltRhssNoGcInAltsNothing(NonVoidbndr)alts;emitSwitchtag_exprbranchesmb_deflt0(tyConFamilySizetycon-1)}wheredo_enum_primop::PrimOp->[StgArg]->FCodeCmmExprdo_enum_primopTagToEnumOp[arg]-- No code!=getArgAmode(NonVoidarg)do_enum_primopprimopargs=dotmp<-newTempbWordcgPrimOp[tmp]primopargsreturn(CmmReg(CmmLocaltmp)){-
Note [case on bool]
This special case handles code like
case a <# b of
True ->
False ->
If we let the ordinary case code handle it, we'll get something like
tmp1 = a < b
tmp2 = Bool_closure_tbl[tmp1]
if (tmp2 & 7 != 0) then ... // normal tagged case
but this junk won't optimise away. What we really want is just an
inline comparison:
if (a < b) then ...
So we add a special case to generate
tmp1 = a < b
if (tmp1 == 0) then ...
and later optimisations will further improve this.
We should really change all these primops to return Int# instead, that
would make this special case go away.
-}-- Note [ticket #3132]: we might be looking at a case of a lifted Id-- that was cast to an unlifted type. The Id will always be bottom,-- but we don't want the code generator to fall over here. If we-- just emit an assignment here, the assignment will be-- type-incorrect Cmm. Hence, we emit the usual enter/return code,-- (and because bottom must be untagged, it will be entered and the-- program will crash).-- The Sequel is a type-correct assignment, albeit bogus.-- The (dead) continuation loops; it would be better to invoke some kind-- of panic function here.---- However, we also want to allow an assignment to be generated-- in the case when the types are compatible, because this allows-- some slightly-dodgy but occasionally-useful casts to be used,-- such as in RtClosureInspect where we cast an HValue to a MutVar#-- so we can print out the contents of the MutVar#. If we generate-- code that enters the HValue, then we'll get a runtime panic, because-- the HValue really is a MutVar#. The types are compatible though,-- so we can just generate an assignment.cgCase(StgAppv[])bndralt_type@(PrimAlt_)alts|isUnLiftedType(idTypev)||reps_compatible=-- assignment suffices for unlifted typesdo{when(notreps_compatible)$panic"cgCase: reps do not match, perhaps a dodgy unsafeCoerce?";v_info<-getCgIdInfov;emitAssign(CmmLocal(idToReg(NonVoidbndr)))(idInfoToAmodev_info);_<-bindArgsToRegs[NonVoidbndr];cgAltsNoGcInAlts(NonVoidbndr)alt_typealts}wherereps_compatible=idPrimRepv==idPrimRepbndrcgCasescrut@(StgAppv[])_(PrimAlt_)_=-- fail at run-time, not compile-timedo{mb_cc<-maybeSaveCostCentreTrue;withSequel(AssignTo[idToReg(NonVoidv)]False)(cgExprscrut);restoreCurrentCostCentremb_cc;emitComment$mkFastString"should be unreachable code";l<-newLabelC;emitLabell;emit(mkBranchl)}{-
case seq# a s of v
(# s', a' #) -> e
==>
case a of v
(# s', a' #) -> e
(taking advantage of the fact that the return convention for (# State#, a #)
is the same as the return convention for just 'a')
-}cgCase(StgOpApp(StgPrimOpSeqOp)[StgVarArga,_]_)bndralt_typealts=-- handle seq#, same return convention as vanilla 'a'.cgCase(StgAppa[])bndralt_typealtscgCasescrutbndralt_typealts=-- the general casedo{up_hp_usg<-getVirtHp-- Upstream heap usage;letret_bndrs=chooseReturnBndrsbndralt_typealtsalt_regs=mapidToRegret_bndrssimple_scrut=isSimpleScrutscrutalt_typegcInAlts|notsimple_scrut=True|isSingletonalts=False|up_hp_usg>0=False|otherwise=Truegc_plan=ifgcInAltsthenGcInAltsalt_regselseNoGcInAlts;mb_cc<-maybeSaveCostCentresimple_scrut;withSequel(AssignToalt_regsgcInAlts)(cgExprscrut);restoreCurrentCostCentremb_cc-- JD: We need Note: [Better Alt Heap Checks];_<-bindArgsToRegsret_bndrs;cgAltsgc_plan(NonVoidbndr)alt_typealts}-----------------maybeSaveCostCentre::Bool->FCode(MaybeLocalReg)maybeSaveCostCentresimple_scrut|simple_scrut=saveCurrentCostCentre|otherwise=returnNothing-----------------isSimpleScrut::StgExpr->AltType->Bool-- Simple scrutinee, does not block or allocate; hence safe to amalgamate-- heap usage from alternatives into the stuff before the case-- NB: if you get this wrong, and claim that the expression doesn't allocate-- when it does, you'll deeply mess up allocationisSimpleScrut(StgOpAppop__)_=isSimpleOpopisSimpleScrut(StgLit_)_=True-- case 1# of { 0# -> ..; ... }isSimpleScrut(StgApp_[])(PrimAlt_)=True-- case x# of { 0# -> ..; ... }isSimpleScrut__=FalseisSimpleOp::StgOp->Bool-- True iff the op cannot block or allocateisSimpleOp(StgFCallOp(CCall(CCallSpec__safe))_)=not(playSafesafe)isSimpleOp(StgPrimOpop)=not(primOpOutOfLineop)isSimpleOp(StgPrimCallOp_)=False-----------------chooseReturnBndrs::Id->AltType->[StgAlt]->[NonVoidId]-- These are the binders of a case that are assigned-- by the evaluation of the scrutinee-- Only non-void ones come backchooseReturnBndrsbndr(PrimAlt_)_alts=nonVoidIds[bndr]chooseReturnBndrs_bndr(UbxTupAlt_)[(_,ids,_,_)]=nonVoidIdsids-- 'bndr' is not assigned!chooseReturnBndrsbndr(AlgAlt_)_alts=nonVoidIds[bndr]-- Only 'bndr' is assignedchooseReturnBndrsbndrPolyAlt_alts=nonVoidIds[bndr]-- Only 'bndr' is assignedchooseReturnBndrs___=panic"chooseReturnBndrs"-- UbxTupALt has only one alternative-------------------------------------cgAlts::GcPlan->NonVoidId->AltType->[StgAlt]->FCode()-- At this point the result of the case are in the binderscgAltsgc_plan_bndrPolyAlt[(_,_,_,rhs)]=maybeAltHeapCheckgc_planNothing(cgExprrhs)cgAltsgc_plan_bndr(UbxTupAlt_)[(_,_,_,rhs)]=maybeAltHeapCheckgc_planNothing(cgExprrhs)-- Here bndrs are *already* in scope, so don't rebind themcgAltsgc_planbndr(PrimAlt_)alts=do{tagged_cmms<-cgAltRhssgc_planNothingbndralts;letbndr_reg=CmmLocal(idToRegbndr)(DEFAULT,deflt)=headtagged_cmms-- PrimAlts always have a DEFAULT case-- and it always comes firsttagged_cmms'=[(lit,code)|(LitAltlit,code)<-tagged_cmms];emitCmmLitSwitch(CmmRegbndr_reg)tagged_cmms'deflt}cgAltsgc_planbndr(AlgAlttycon)alts=do{retry_lbl<-newLabelC;emitLabelretry_lbl-- Note [alg-alt heap checks];(mb_deflt,branches)<-cgAlgAltRhssgc_plan(Justretry_lbl)bndralts;letfam_sz=tyConFamilySizetyconbndr_reg=CmmLocal(idToRegbndr)-- Is the constructor tag in the node reg?;ifisSmallFamilyfam_szthenlet-- Yes, bndr_reg has constr. tag in ls bitstag_expr=cmmConstrTag1(CmmRegbndr_reg)branches'=[(tag+1,branch)|(tag,branch)<-branches]inemitSwitchtag_exprbranches'mb_deflt1fam_szelse-- No, get tag from info tablelet-- Note that ptr _always_ has tag 1-- when the family size is big enoughuntagged_ptr=cmmRegOffBbndr_reg(-1)tag_expr=getConstrTag(untagged_ptr)inemitSwitchtag_exprbranchesmb_deflt0(fam_sz-1)}cgAlts____=panic"cgAlts"-- UbxTupAlt and PolyAlt have only one alternative-- Note [alg-alt heap check]---- In an algebraic case with more than one alternative, we will have-- code like---- L0:-- x = R1-- goto L1-- L1:-- if (x & 7 >= 2) then goto L2 else goto L3-- L2:-- Hp = Hp + 16-- if (Hp > HpLim) then goto L4-- ...-- L4:-- call gc() returns to L5-- L5:-- x = R1-- goto L1-------------------cgAlgAltRhss::GcPlan->MaybeBlockId->NonVoidId->[StgAlt]->FCode(MaybeCmmAGraph,[(ConTagZ,CmmAGraph)])cgAlgAltRhssgc_planretry_lblbndralts=do{tagged_cmms<-cgAltRhssgc_planretry_lblbndralts;let{mb_deflt=casetagged_cmmsof((DEFAULT,rhs):_)->Justrhs_other->Nothing-- DEFAULT is always first, if present;branches=[(dataConTagZcon,cmm)|(DataAltcon,cmm)<-tagged_cmms]};return(mb_deflt,branches)}-------------------cgAltRhss::GcPlan->MaybeBlockId->NonVoidId->[StgAlt]->FCode[(AltCon,CmmAGraph)]cgAltRhssgc_planretry_lblbndralts=forkAlts(mapcg_altalts)wherebase_reg=idToRegbndrcg_alt::StgAlt->FCode(AltCon,CmmAGraph)cg_alt(con,bndrs,_uses,rhs)=getCodeR$maybeAltHeapCheckgc_planretry_lbl$do{_<-bindConArgsconbase_regbndrs;cgExprrhs;returncon}maybeAltHeapCheck::GcPlan->MaybeBlockId->FCodea->FCodeamaybeAltHeapCheckNoGcInAlts_code=codemaybeAltHeapCheck(GcInAltsregs)mlblcode=casemlblofNothing->altHeapCheckregscodeJustretry_lbl->altHeapCheckReturnsToregsretry_lblcode------------------------------------------------------------------------------- Tail calls-----------------------------------------------------------------------------cgConApp::DataCon->[StgArg]->FCode()cgConAppconstg_args|isUnboxedTupleConcon-- Unboxed tuple: assign and return=do{arg_exprs<-getNonVoidArgAmodesstg_args;tickyUnboxedTupleReturn(lengtharg_exprs);emitReturnarg_exprs}|otherwise-- Boxed constructors; allocate and return=ASSERT(stg_args`lengthIs`dataConRepRepAritycon)do{(idinfo,init)<-buildDynCon(dataConWorkIdcon)currentCCSconstg_args-- The first "con" says that the name bound to this closure is-- is "con", which is a bit of a fudge, but it only affects profiling;emitinit;emitReturn[idInfoToAmodeidinfo]}cgIdApp::Id->[StgArg]->FCode()cgIdAppfun_id[]|isVoidIdfun_id=emitReturn[]cgIdAppfun_idargs=do{fun_info<-getCgIdInfofun_id;casemaybeLetNoEscapefun_infoofJust(blk_id,lne_regs)->cgLneJumpblk_idlne_regsargsNothing->cgTailCallfun_idfun_infoargs}cgLneJump::BlockId->[LocalReg]->[StgArg]->FCode()cgLneJumpblk_idlne_regsargs-- Join point; discard sequel=do{adjustHpBackwards-- always do this before a tail-call;cmm_args<-getNonVoidArgAmodesargs;emitMultiAssignlne_regscmm_args;emit(mkBranchblk_id)}cgTailCall::Id->CgIdInfo->[StgArg]->FCode()cgTailCallfun_idfun_infoargs=dodflags<-getDynFlagscase(getCallMethoddflagsfun_name(idCafInfofun_id)lf_info(lengthargs))of-- A value in WHNF, so we can just return it.ReturnIt->emitReturn[fun]-- ToDo: does ReturnIt guarantee tagged?EnterIt->ASSERT(nullargs)-- Discarding argumentsemitEnterfunSlowCall->do-- A slow function call via the RTS apply routines{tickySlowCalllf_infoargs;emitComment$mkFastString"slowCall";slowCallfunargs}-- A direct function call (possibly with some left-over arguments)DirectEntrylblarity->do{tickyDirectCallarityargs;ifnode_pointsthendirectCallNativeNodeCalllblarity(fun_arg:args)elsedirectCallNativeDirectCalllblarityargs}JumpToIt{}->panic"cgTailCall"-- ???wherefun_arg=StgVarArgfun_idfun_name=idNamefun_idfun=idInfoToAmodefun_infolf_info=cgIdInfoLFfun_infonode_points=nodeMustPointToItlf_infoemitEnter::CmmExpr->FCode()emitEnterfun=do{adjustHpBackwards;sequel<-getSequel;updfr_off<-getUpdFrameOff;casesequelof-- For a return, we have the option of generating a tag-test or-- not. If the value is tagged, we can return directly, which-- is quicker than entering the value. This is a code-- size/speed trade-off: when optimising for speed rather than-- size we could generate the tag test.---- Right now, we do what the old codegen did, and omit the tag-- test, just generating an enter.Return_->do{letentry=entryCode$closureInfoPtr$CmmRegnodeReg;emit$mkForeignJumpNativeNodeCallentry[cmmUntagfun]updfr_off}-- The result will be scrutinised in the sequel. This is where-- we generate a tag-test to avoid entering the closure if-- possible.---- The generated code will be something like this:---- R1 = fun -- copyout-- if (fun & 7 != 0) goto Lcall else goto Lret-- Lcall:-- call [fun] returns to Lret-- Lret:-- fun' = R1 -- copyin-- ...---- Note in particular that the label Lret is used as a-- destination by both the tag-test and the call. This is-- becase Lret will necessarily be a proc-point, and we want to-- ensure that we generate only one proc-point for this-- sequence.--AssignTores_regs_->do{lret<-newLabelC;lcall<-newLabelC;letarea=Younglret;let(off,copyin)=copyInOflowNativeReturnareares_regs(outArgs,regs,copyout)=copyOutOflowNativeNodeCallCallarea[fun]updfr_off(0,[])-- refer to fun via nodeReg after the copyout, to avoid having-- both live simultaneously; this sometimes enables fun to be-- inlined in the RHS of the R1 assignment.;letentry=entryCode(closureInfoPtr(CmmRegnodeReg))the_call=toCallentry(Justlret)updfr_offoffoutArgsregs;emit$copyout<*>mkCbranch(cmmIsTagged(CmmRegnodeReg))lretlcall<*>outOfLinelcallthe_call<*>mkLabellret<*>copyin}}{- Note [Better Alt Heap Checks]
If two function calls can share a return point, then they will also
get the same info table. Therefore, it's worth our effort to make
those opportunities appear as frequently as possible.
Here are a few examples of how it should work:
STG:
case f x of
True -> <True code -- including allocation>
False -> <False code>
Cmm:
r = call f(x) returns to L;
L:
if r & 7 >= 2 goto L1 else goto L2;
L1:
if Hp > HpLim then
r = gc(r);
goto L;
<True code -- including allocation>
L2:
<False code>
Note that the code following both the call to f(x) and the code to gc(r)
should be the same, which will allow the common blockifier to discover
that they are the same. Therefore, both function calls will return to the same
block, and they will use the same info table.
Here's an example of the Cmm code we want from a primOp.
The primOp doesn't produce an info table for us to reuse, but that's okay:
we should still generate the same code:
STG:
case f x of
0 -> <0-case code -- including allocation>
_ -> <default-case code>
Cmm:
r = a +# b;
L:
if r == 0 then goto L1 else goto L2;
L1:
if Hp > HpLim then
r = gc(r);
goto L;
<0-case code -- including allocation>
L2:
<default-case code>
-}