X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgCon.lhs;h=3a0d539cb2e93655dcd0aa4a0cfa34486d9b7dc5;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=938582741d6b46c067585c3521842737a4eb31aa;hpb=10521d8418fd3a1cf32882718b5bd28992db36fd;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs index 9385827..3a0d539 100644 --- a/ghc/compiler/codeGen/CgCon.lhs +++ b/ghc/compiler/codeGen/CgCon.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP Project, Glasgow University, 1992-1995 +% (c) The GRASP Project, Glasgow University, 1992-1998 % \section[CgCon]{Code generation for constructors} @@ -8,64 +8,47 @@ with {\em constructors} on the RHSs of let(rec)s. See also @CgClosure@, which deals with closures. \begin{code} -#include "HsVersions.h" - module CgCon ( - -- it's all exported, actually... cgTopRhsCon, buildDynCon, - bindConArgs, - cgReturnDataCon, - - -- and to make the interface self-sufficient... - Id, StgAtom, CgState, CAddrMode, - PrimKind, PrimOp, MagicId + bindConArgs, bindUnboxedTupleComponents, + cgReturnDataCon ) where -IMPORT_Trace -- ToDo: rm (debugging) -import Outputable -import Pretty +#include "HsVersions.h" -import StgSyn import CgMonad import AbsCSyn +import StgSyn -import AbsUniType ( maybeCharLikeTyCon, maybeIntLikeTyCon, TyVar, - TyCon, Class, UniType - ) -import CgBindery ( getAtomAmode, getAtomAmodes, bindNewToNode, - bindArgsToRegs, newTempAmodeAndIdInfo, idInfoToAmode +import AbsCUtils ( getAmodeRep ) +import CgBindery ( getArgAmodes, bindNewToNode, + bindArgsToRegs, newTempAmodeAndIdInfo, + idInfoToAmode, stableAmodeIdInfo, + heapIdInfo, CgIdInfo, bindNewToStack ) +import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots ) +import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp ) import CgClosure ( cgTopRhsClosure ) -import CgHeapery ( allocDynClosure, heapCheck -#ifdef GRAN - , fetchAndReschedule -- HWL -#endif {- GRAN -} - ) -import CgCompInfo ( mAX_INTLIKE, mIN_INTLIKE ) - -import CgRetConv ( dataReturnConvAlg, mkLiveRegsBitMask, - CtrlReturnConvention(..), DataReturnConvention(..) - ) -import CgTailCall ( performReturn, mkStaticAlgReturnCode ) -import CgUsages ( getHpRelOffset ) -import CLabelInfo ( CLabel, mkClosureLabel, mkInfoTableLabel, - mkPhantomInfoTableLabel, - mkConEntryLabel, mkStdEntryLabel - ) -import ClosureInfo -- hiding ( auxInfoTableLabelFromCI ) -- I hate pragmas - {-( mkConLFInfo, mkLFArgument, closureLFInfo, +import CgRetConv ( assignRegs ) +import Constants ( mAX_INTLIKE, mIN_INTLIKE ) +import CgHeapery ( allocDynClosure ) +import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall, + mkUnboxedTupleReturnCode ) +import CLabel ( mkClosureLabel, mkStaticClosureLabel ) +import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument, layOutDynCon, layOutDynClosure, - layOutStaticClosure, UpdateFlag(..), - mkClosureLFInfo, layOutStaticNoFVClosure - )-} -import Id ( getIdKind, getDataConTag, getDataConTyCon, - isDataCon, fIRST_TAG, DataCon(..), ConTag(..) + layOutStaticClosure ) -import CmdLineOpts ( GlobalSwitch(..) ) -import Maybes ( maybeToBool, Maybe(..) ) -import PrimKind ( PrimKind(..), isFloatingKind, getKindSize ) -import CostCentre -import UniqSet -- ( emptyUniqSet, UniqSet(..) ) +import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack, + currentCCS ) +import DataCon ( DataCon, dataConName, dataConTag, dataConTyCon, + isUnboxedTupleCon ) +import MkId ( mkDataConId ) +import Id ( Id, idName, idType, idPrimRep ) +import Const ( Con(..), Literal(..) ) +import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon ) +import PrimRep ( PrimRep(..) ) +import BasicTypes ( TopLevelFlag(..) ) import Util \end{code} @@ -78,20 +61,19 @@ import Util \begin{code} cgTopRhsCon :: Id -- Name of thing bound to this RHS -> DataCon -- Id - -> [PlainStgAtom] -- Args + -> [StgArg] -- Args -> Bool -- All zero-size args (see buildDynCon) -> FCode (Id, CgIdInfo) \end{code} -Special Case: -Constructors some of whose arguments are of \tr{Float#} or -\tr{Double#} type, {\em or} which are ``lit lits'' (which are given -\tr{Addr#} type). +Special Case: Constructors some of whose arguments are of \tr{Double#} +type, {\em or} which are ``lit lits'' (which are given \tr{Addr#} +type). -These ones have to be compiled as re-entrant thunks rather than closures, -because we can't figure out a way to persuade C to allow us to initialise a -static closure with Floats and Doubles! -Thus, for \tr{x = 2.0} (defaults to Double), we get: +These ones have to be compiled as re-entrant thunks rather than +closures, because we can't figure out a way to persuade C to allow us +to initialise a static closure with Doubles! Thus, for \tr{x = 2.0} +(defaults to Double), we get: \begin{verbatim} -- The STG syntax: @@ -106,7 +88,7 @@ Thus, for \tr{x = 2.0} (defaults to Double), we get: STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double"); -- with its *own* entry code: STGFUN(Main_x_entry) { - P_ u1701; + P_ u1701; RetDouble1=2.0; u1701=(P_)*SpB; SpB=SpB-1; @@ -122,193 +104,55 @@ ones). On the plus side, however, it does return a value (\tr{2.0}) Here, then is the implementation: just pretend it's a non-updatable thunk. That is, instead of - x = F# 3.455# + x = D# 3.455# pretend we've seen - x = [] \n [] -> F# 3.455# + x = [] \n [] -> D# 3.455# \begin{code} -top_cc = dontCareCostCentre -- out here to avoid a cgTopRhsCon CAF (sigh) -top_ccc = mkCCostCentre dontCareCostCentre -- because it's static data +top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data -cgTopRhsCon name con args all_zero_size_args - | any (isFloatingKind . getAtomKind) args - || any isLitLitStgAtom args - = cgTopRhsClosure name top_cc NoStgBinderInfo [] body lf_info +cgTopRhsCon bndr con args all_zero_size_args + | any isLitLitArg args + = cgTopRhsClosure bndr dontCareCCS NoStgBinderInfo NoSRT [] body lf_info where - body = StgConApp con args emptyUniqSet{-emptyLiveVarSet-} - lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant [] body + body = StgCon (DataCon con) args rhs_ty + lf_info = mkClosureLFInfo bndr TopLevel [] ReEntrant [] + rhs_ty = idType bndr \end{code} OK, so now we have the general case. \begin{code} -cgTopRhsCon name con args all_zero_size_args +cgTopRhsCon id con args all_zero_size_args = ( - ASSERT(isDataCon con) - -- LAY IT OUT - getAtomAmodes args `thenFC` \ amodes -> + getArgAmodes args `thenFC` \ amodes -> let (closure_info, amodes_w_offsets) - = layOutStaticClosure name getAmodeKind amodes lf_info + = layOutStaticClosure name getAmodeRep amodes lf_info in - -- HWL: In 0.22 there was a heap check in here that had to be changed. - -- CHECK if having no heap check is ok for GrAnSim here!!! -- BUILD THE OBJECT absC (CStaticClosure - closure_label -- Labelled with the name on lhs of defn - closure_info -- Closure is static + closure_label -- Labelled with the name on lhs of defn + closure_info -- Closure is static top_ccc - (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs + (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs ) `thenC` -- RETURN - returnFC (name, stableAmodeIdInfo name (CLbl closure_label PtrKind) lf_info) + returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info) where - con_tycon = getDataConTyCon con - lf_info = mkConLFInfo con - - closure_label = mkClosureLabel name - info_label = mkInfoTableLabel con - con_entry_label = mkConEntryLabel con - entry_label = mkStdEntryLabel name + con_tycon = dataConTyCon con + lf_info = mkConLFInfo con + closure_label = mkClosureLabel name + name = idName id \end{code} -The general case is: -\begin{verbatim} --- code: - data Foo = MkFoo - x = MkFoo - --- STG code: -STG syntax: - Main.x = Main.MkFoo [] - --- interesting parts of the C Code: - --- closure for "x": - SET_STATIC_HDR(Main_x_closure,Main_MkFoo_static,CC_DATA,,EXTDATA_RO) - }; --- entry code for "x": - STGFUN(Main_x_entry) { - Node=(W_)(Main_x_closure); - STGJUMP(Main_MkFoo_entry); - } -\end{verbatim} - -Observe: (1)~We create a static closure for \tr{x}, {\em reusing} the -regular \tr{MkFoo} info-table and entry code. (2)~However: the -\tr{MkFoo} code expects Node to be set, but the caller of \tr{x_entry} -will not have set it. Therefore, the whole point of \tr{x_entry} is -to set node (and then call the shared \tr{MkFoo} entry code). - - - -Special Case: -For top-level Int/Char constants. We get entry-code fragments of the form: - -\begin{verbatim} --- code: - y = 1 - --- entry code for "y": - STGFUN(Main_y_entry) { - Node=(W_)(Main_y_closure); - STGJUMP(I#_entry); - } -\end{verbatim} - -This is pretty tiresome: we {\em know} what the constant is---we'd -rather just return it. We end up with something that's a hybrid -between the Float/Double and general cases: (a)~like Floats/Doubles, -the entry-code returns the value immediately; (b)~like the general -case, we share the data-constructor's std info table. So, what we -want is: -\begin{verbatim} --- code: - z = 1 - --- STG code: -STG syntax: - Main.z = I# [1#] - --- interesting parts of the C Code: - --- closure for "z" (shares I# info table): - SET_STATIC_HDR(Main_z_closure,I#_static,CC_DATA,,EXTDATA_RO) - }; --- entry code for "z" (do the business directly): - STGFUN(Main_z_entry) { - P_ u1702; - Ret1=1; - u1702=(P_)*SpB; - SpB=SpB-1; - JMP_(u1702[0]); - } -\end{verbatim} - -This blob used to be in cgTopRhsCon, but I don't see how we can -jump direct to the named code for a constructor; any external entries -will be via Node. Generating all this extra code is a real waste -for big static data structures. So I've nuked it. SLPJ Sept 94 - - -Further discourse on these entry-code fragments (NB this isn't done -yet [ToDo]): They're really pretty pointless, except for {\em -exported} top-level constants (the rare case). Consider: -\begin{verbatim} -y = p : ps -- y is not exported -f a b = y -g c = (y, c) -\end{verbatim} -Why have a \tr{y_entry} fragment at all? The code generator should -``know enough'' about \tr{y} not to need it. For the first case -above, with \tr{y} in ``head position,'' it should generate code just -as for an \tr{StgRhsCon} (possibly because the STG simplification -actually did the unfolding to make it so). At the least, it should -load up \tr{Node} and call \tr{Cons}'s entry code---not some special -\tr{y_entry} code. - -\begin{pseudocode} - -- WE NEED AN ENTRY PT, IN CASE SOMEONE JUMPS DIRECT TO name - -- FROM OUTSIDE. NB: this CCodeBlock precedes the - -- CStaticClosure for the same reason (fewer forward refs) as - -- we did in CgClosure. - - -- we either have ``in-line'' returning code (special case) - -- or we set Node and jump to the constructor's entry code - - (if maybeToBool (maybeCharLikeTyCon con_tycon) - || maybeToBool (maybeIntLikeTyCon con_tycon) - then -- special case - getAbsC (-- OLD: No, we don't fiddle cost-centres on - -- entry to data values any more (WDP 94/06) - -- lexCostCentreC "ENTER_CC_D" [top_ccc] - -- `thenC` - cgReturnDataCon con amodes all_zero_size_args emptyUniqSet{-no live vars-}) - else -- boring case - returnFC ( - mkAbstractCs [ - -- Node := this_closure - CAssign (CReg node) (CLbl closure_label PtrKind), - -- InfoPtr := info table for this_closure - CAssign (CReg infoptr) (CLbl info_label DataPtrKind), - -- Jump to std code for this constructor - CJump (CLbl con_entry_label CodePtrKind) - ]) - ) `thenFC` \ ret_absC -> - - absC (CCodeBlock entry_label ret_absC) `thenC` -\end{pseudocode} - -=========================== END OF OLD STUFF ============================== - - %************************************************************************ %* * %* non-top-level constructors * @@ -319,12 +163,12 @@ load up \tr{Node} and call \tr{Cons}'s entry code---not some special \begin{code} buildDynCon :: Id -- Name of the thing to which this constr will -- be bound - -> CostCentre -- Where to grab cost centre from; - -- current CC if currentOrSubsumedCosts + -> CostCentreStack -- Where to grab cost centre from; + -- current CCS if currentOrSubsumedCCS -> DataCon -- The data constructor -> [CAddrMode] -- Its args -> Bool -- True <=> all args (if any) are - -- of "zero size" (i.e., VoidKind); + -- of "zero size" (i.e., VoidRep); -- The reason we don't just look at the -- args is that we may be in a "knot", and -- premature looking at the args will cause @@ -333,69 +177,68 @@ buildDynCon :: Id -- Name of the thing to which this constr will \end{code} First we deal with the case of zero-arity constructors. Now, they -will probably be unfolded, so we don't expect to see this case -much, if at all, but it does no harm, and sets the scene for characters. +will probably be unfolded, so we don't expect to see this case much, +if at all, but it does no harm, and sets the scene for characters. -In the case of zero-arity constructors, or, more accurately, -those which have exclusively size-zero (VoidKind) args, -we generate no code at all. +In the case of zero-arity constructors, or, more accurately, those +which have exclusively size-zero (VoidRep) args, we generate no code +at all. \begin{code} buildDynCon binder cc con args all_zero_size_args@True - = ASSERT(isDataCon con) - returnFC (stableAmodeIdInfo binder - (CLbl (mkClosureLabel con) PtrKind) + = returnFC (stableAmodeIdInfo binder + (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep) (mkConLFInfo con)) \end{code} Now for @Char@-like closures. We generate an assignment of the address of the closure to a temporary. It would be possible simply to -generate no code, and record the addressing mode in the environment, but -we'd have to be careful if the argument wasn't a constant --- so for simplicity -we just always asssign to a temporary. +generate no code, and record the addressing mode in the environment, +but we'd have to be careful if the argument wasn't a constant --- so +for simplicity we just always asssign to a temporary. -Last special case: @Int@-like closures. We only special-case the situation -in which the argument is a literal in the range @mIN_INTLIKE@..@mAX_INTLILKE@. -NB: for @Char@-like closures we can work with any old argument, but -for @Int@-like ones the argument has to be a literal. Reason: @Char@ like -closures have an argument type which is guaranteed in range. +Last special case: @Int@-like closures. We only special-case the +situation in which the argument is a literal in the range +@mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can +work with any old argument, but for @Int@-like ones the argument has +to be a literal. Reason: @Char@ like closures have an argument type +which is guaranteed in range. Because of this, we use can safely return an addressing mode. \begin{code} buildDynCon binder cc con [arg_amode] all_zero_size_args@False - | maybeToBool (maybeCharLikeTyCon tycon) - = ASSERT(isDataCon con) - absC (CAssign temp_amode (CCharLike arg_amode)) `thenC` + | maybeCharLikeCon con + = absC (CAssign temp_amode (CCharLike arg_amode)) `thenC` returnFC temp_id_info - | maybeToBool (maybeIntLikeTyCon tycon) && in_range_int_lit arg_amode - = ASSERT(isDataCon con) - returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con)) + | maybeIntLikeCon con && in_range_int_lit arg_amode + = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con)) where - tycon = getDataConTyCon con (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con) - in_range_int_lit (CLit (MachInt val _)) = (val <= mAX_INTLIKE) && (val >= mIN_INTLIKE) - in_range_int_lit other_amode = False + in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE + in_range_int_lit other_amode = False + + tycon = dataConTyCon con \end{code} Now the general case. \begin{code} -buildDynCon binder cc con args all_zero_size_args@False - = ASSERT(isDataCon con) - allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off -> - returnFC (heapIdInfo binder hp_off (mkConLFInfo con)) +buildDynCon binder ccs con args all_zero_size_args@False + = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off -> + returnFC (heapIdInfo binder hp_off lf_info) where (closure_info, amodes_w_offsets) - = layOutDynClosure binder getAmodeKind args (mkConLFInfo con) + = layOutDynClosure (idName binder) getAmodeRep args lf_info + lf_info = mkConLFInfo con use_cc -- cost-centre to stick in the object - = if currentOrSubsumedCosts cc + = if currentOrSubsumedCCS ccs then CReg CurCostCentre - else mkCCostCentre cc + else mkCCostCentreStack ccs blame_cc = use_cc -- cost-centre on which to blame the alloc (same) \end{code} @@ -414,22 +257,51 @@ binders $args$, assuming that we have just returned from a @case@ which found a $con$. \begin{code} -bindConArgs :: DataCon -> [Id] -> Code +bindConArgs + :: DataCon -> [Id] -- Constructor and args + -> Code + bindConArgs con args - = ASSERT(isDataCon con) - getIntSwitchChkrC `thenFC` \ isw_chkr -> - - case (dataReturnConvAlg isw_chkr con) of - ReturnInRegs rs -> bindArgsToRegs args rs - ReturnInHeap -> - let - (_, args_w_offsets) = layOutDynCon con getIdKind args - in - mapCs bind_arg args_w_offsets + = ASSERT(not (isUnboxedTupleCon con)) + mapCs bind_arg args_w_offsets where bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument + (_, args_w_offsets) = layOutDynCon con idPrimRep args \end{code} +Unboxed tuples are handled slightly differently - the object is +returned in registers and on the stack instead of the heap. + +\begin{code} +bindUnboxedTupleComponents + :: [Id] -- args + -> FCode ([MagicId], -- regs assigned + [(VirtualSpOffset,Int)], -- tag slots + Bool) -- any components on stack? + +bindUnboxedTupleComponents args + = -- Assign as many components as possible to registers + let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args) + (reg_args, stk_args) = splitAt (length arg_regs) args + in + + -- Allocate the rest on the stack (ToDo: separate out pointers) + getVirtSp `thenFC` \ vsp -> + getRealSp `thenFC` \ rsp -> + let (top_sp, stk_offsets, tags) = + mkTaggedVirtStkOffsets rsp idPrimRep stk_args + in + + -- The stack pointer points to the last stack-allocated component + setRealAndVirtualSp top_sp `thenC` + + -- need to explicitly free any empty slots we just jumped over + (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC` + + bindArgsToRegs reg_args arg_regs `thenC` + mapCs bindNewToStack stk_offsets `thenC` + returnFC (arg_regs,tags, not (null stk_offsets)) +\end{code} %************************************************************************ %* * @@ -441,18 +313,16 @@ bindConArgs con args Note: it's the responsibility of the @cgReturnDataCon@ caller to be sure the @amodes@ passed don't conflict with each other. \begin{code} -cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> PlainStgLiveVars -> Code +cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> Code -cgReturnDataCon con amodes all_zero_size_args live_vars - = ASSERT(isDataCon con) - getIntSwitchChkrC `thenFC` \ isw_chkr -> - getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) -> +cgReturnDataCon con amodes all_zero_size_args + = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) -> case sequel of CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl)))) - | not (getDataConTag con `is_elem` map fst alts) - -> + | not (dataConTag con `is_elem` map fst alts) + -> -- Special case! We're returning a constructor to the default case -- of an enclosing case. For example: -- @@ -460,59 +330,68 @@ cgReturnDataCon con amodes all_zero_size_args live_vars -- D x -> ... -- y -> ...... -- - -- In this case, + -- In this case, -- if the default is a non-bind-default (ie does not use y), -- then we should simply jump to the default join point; -- -- if the default is a bind-default (ie does use y), we - -- should return the constructor IN THE HEAP, pointed to by Node, - -- **regardless** of the return convention of the constructor C. + -- should return the constructor in the heap, + -- pointed to by Node. case maybe_deflt_binder of - Just binder -> - buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args + Just binder -> + ASSERT(not (isUnboxedTupleCon con)) + buildDynCon binder currentCCS con amodes all_zero_size_args `thenFC` \ idinfo -> - idInfoToAmode PtrKind idinfo `thenFC` \ amode -> - performReturn (move_to_reg amode node) jump_to_join_point live_vars + idInfoToAmode PtrRep idinfo `thenFC` \ amode -> + performReturn (move_to_reg amode node) jump_to_join_point Nothing -> - performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars + performReturn AbsCNop {- No reg assts -} jump_to_join_point where is_elem = isIn "cgReturnDataCon" - jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrKind)) + jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep)) -- Ignore the sequel: we've already looked at it above - other_sequel -> -- The usual case - case (dataReturnConvAlg isw_chkr con) of + other_sequel -- The usual case - ReturnInHeap -> + | isUnboxedTupleCon con -> + -- Return unboxed tuple in registers + let (ret_regs, leftovers) = + assignRegs [] (map getAmodeRep amodes) + in + doTailCall amodes ret_regs + mkUnboxedTupleReturnCode + (length leftovers) {- fast args arity -} + AbsCNop {-no pending assigments-} + Nothing {-not a let-no-escape-} + False {-node doesn't point-} + + | otherwise -> -- BUILD THE OBJECT IN THE HEAP -- The first "con" says that the name bound to this -- closure is "con", which is a bit of a fudge, but it only - -- affects profiling (ToDo?) - buildDynCon con useCurrentCostCentre con amodes all_zero_size_args + -- affects profiling + + -- This Id is also used to get a unique for a + -- temporary variable, if the closure is a CHARLIKE. + -- funilly enough, this makes the unique always come + -- out as '54' :-) + buildDynCon (mkDataConId con) currentCCS + con amodes all_zero_size_args `thenFC` \ idinfo -> - idInfoToAmode PtrKind idinfo `thenFC` \ amode -> - - -- MAKE NODE POINT TO IT - let reg_assts = move_to_reg amode node - info_lbl = mkInfoTableLabel con - in + idInfoToAmode PtrRep idinfo `thenFC` \ amode -> - -- RETURN - profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC` - - performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars - ReturnInRegs regs -> - let - reg_assts = mkAbstractCs (zipWith move_to_reg amodes regs) - info_lbl = mkPhantomInfoTableLabel con - in - profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC` + -- RETURN + profCtrC SLIT("TICK_RET_CON") [mkIntCLit (length amodes)] `thenC` + -- could use doTailCall here. + performReturn (move_to_reg amode node) + (mkStaticAlgReturnCode con) - performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars where + con_name = dataConName con + move_to_reg :: CAddrMode -> MagicId -> AbstractC move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode \end{code}