X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgExpr.lhs;h=9ab2ab2a552204920e53394d55e89ea19475de2b;hb=8d873902b0ba7e267089f9e1faf690368670fe62;hp=4713767f5a6514ad6870ec4abbd4a64854762b1a;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs index 4713767..9ab2ab2 100644 --- a/ghc/compiler/codeGen/CgExpr.lhs +++ b/ghc/compiler/codeGen/CgExpr.lhs @@ -1,5 +1,7 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +% +% $Id: CgExpr.lhs,v 1.35 2000/07/11 16:03:37 simonmar Exp $ % %******************************************************** %* * @@ -8,42 +10,47 @@ %******************************************************** \begin{code} -#include "HsVersions.h" +module CgExpr ( cgExpr ) where -module CgExpr ( - cgExpr, cgSccExpr, getPrimOpArgAmodes - - -- and to make the interface self-sufficient... - ) where +#include "HsVersions.h" +import Constants ( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE ) import StgSyn import CgMonad import AbsCSyn - -import PrelInfo ( PrimOp(..), PrimOpResultInfo(..), HeapRequirement(..), - primOpHeapReq, getPrimOpResultInfo, PrimRep, - primOpCanTriggerGC - IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp) - IF_ATTACK_PRAGMAS(COMMA pprPrimOp) - ) -import Type ( isPrimType, getTyConDataCons ) -import CLabel ( CLabel, mkPhantomInfoTableLabel, mkInfoTableVecTblLabel ) -import ClosureInfo ( LambdaFormInfo, mkClosureLFInfo ) -import CgBindery ( getAtomAmodes ) -import CgCase ( cgCase, saveVolatileVarsAndRegs ) -import CgClosure ( cgRhsClosure ) +import AbsCUtils ( mkAbstractCs ) +import CLabel ( mkClosureTblLabel ) + +import SMRep ( fixedHdrSize ) +import CgBindery ( getArgAmodes, getArgAmode, CgIdInfo, + nukeDeadBindings, addBindC, addBindsC ) +import CgCase ( cgCase, saveVolatileVarsAndRegs, + restoreCurrentCostCentre ) +import CgClosure ( cgRhsClosure, cgStdRhsClosure ) import CgCon ( buildDynCon, cgReturnDataCon ) -import CgHeapery ( allocHeap ) import CgLetNoEscape ( cgLetNoEscapeClosure ) -import CgRetConv -- various things... -import CgTailCall ( cgTailCall, performReturn, mkDynamicAlgReturnCode, - mkPrimReturnCode +import CgRetConv ( dataReturnConvPrim ) +import CgTailCall ( cgTailCall, performReturn, performPrimReturn, + mkDynamicAlgReturnCode, mkPrimReturnCode, + tailCallPrimOp, returnUnboxedTuple ) -import CostCentre ( setToAbleCostCentre, isDupdCC, CostCentre ) -import Maybes ( Maybe(..) ) -import PrimRep ( getPrimRepSize ) -import UniqSet -import Util +import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo, + mkApLFInfo, layOutDynCon ) +import CostCentre ( sccAbleCostCentre, isSccCountCostCentre ) +import Id ( idPrimRep, idType, Id ) +import VarSet +import DataCon ( DataCon, dataConTyCon ) +import PrimOp ( primOpOutOfLine, ccallMayGC, + getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) + ) +import PrimRep ( getPrimRepSize, PrimRep(..), isFollowableRep ) +import TyCon ( maybeTyConSingleCon, + isUnboxedTupleTyCon, isEnumerationTyCon ) +import Type ( Type, typePrimRep, splitTyConApp_maybe, repType ) +import Maybes ( assocMaybe, maybeToBool ) +import Unique ( mkBuiltinUnique ) +import BasicTypes ( TopLevelFlag(..), RecFlag(..) ) +import Outputable \end{code} This module provides the support code for @StgToAbstractC@ to deal @@ -66,7 +73,7 @@ cgExpr :: StgExpr -- input @(STGApp (StgLitArg 42) [])@. \begin{code} -cgExpr (StgApp fun args live_vars) = cgTailCall fun args live_vars +cgExpr (StgApp fun args) = cgTailCall fun args \end{code} %******************************************************** @@ -76,13 +83,21 @@ cgExpr (StgApp fun args live_vars) = cgTailCall fun args live_vars %******************************************************** \begin{code} -cgExpr (StgCon con args live_vars) - = getAtomAmodes args `thenFC` \ amodes -> - cgReturnDataCon con amodes (all zero_size args) live_vars - where - zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0 +cgExpr (StgConApp con args) + = getArgAmodes args `thenFC` \ amodes -> + cgReturnDataCon con amodes \end{code} +Literals are similar to constructors; they return by putting +themselves in an appropriate register and returning to the address on +top of the stack. + +\begin{code} +cgExpr (StgLit lit) + = performPrimReturn (text "literal" <+> ppr lit) (CLit lit) +\end{code} + + %******************************************************** %* * %* STG PrimApps (unboxed primitive ops) * @@ -91,118 +106,86 @@ cgExpr (StgCon con args live_vars) Here is where we insert real live machine instructions. +NOTE about _ccall_GC_: + +A _ccall_GC_ is treated as an out-of-line primop (returns True +for primOpOutOfLine) so that when we see the call in case context + case (ccall ...) of { ... } +we get a proper stack frame on the stack when we perform it. When we +get in a tail-call position, however, we need to actually perform the +call, so we treat it as an inline primop. + \begin{code} -cgExpr x@(StgPrim op args live_vars) - = getIntSwitchChkrC `thenFC` \ isw_chkr -> - getPrimOpArgAmodes op args `thenFC` \ arg_amodes -> - let - result_regs = assignPrimOpResultRegs {-NO:isw_chkr-} op - result_amodes = map CReg result_regs - may_gc = primOpCanTriggerGC op - dyn_tag = head result_amodes - -- The tag from a primitive op returning an algebraic data type - -- is returned in the first result_reg_amode - in - (if may_gc then - -- Use registers for args, and assign args to the regs - -- (Can-trigger-gc primops guarantee to have their args in regs) - let - (arg_robust_amodes, liveness_mask, arg_assts) - = makePrimOpArgsRobust {-NO:isw_chkr-} op arg_amodes - - liveness_arg = mkIntCLit liveness_mask - in - returnFC ( - arg_assts, - COpStmt result_amodes op - (pin_liveness op liveness_arg arg_robust_amodes) - liveness_mask - [{-no vol_regs-}] - ) - else - -- Use args from their current amodes. - let - liveness_mask = panic "cgExpr: liveness of non-GC-ing primop touched\n" - in - returnFC ( - COpStmt result_amodes op arg_amodes liveness_mask [{-no vol_regs-}], - AbsCNop - ) - ) `thenFC` \ (do_before_stack_cleanup, - do_just_before_jump) -> +cgExpr (StgPrimApp op@(CCallOp ccall) args res_ty) + = primRetUnboxedTuple op args res_ty + +-- tagToEnum# is special: we need to pull the constructor out of the table, +-- and perform an appropriate return. + +cgExpr (StgPrimApp TagToEnumOp [arg] res_ty) + = ASSERT(isEnumerationTyCon tycon) + getArgAmode arg `thenFC` \amode -> + -- save the tag in a temporary in case amode overlaps + -- with node. + absC (CAssign dyn_tag amode) `thenC` + performReturn ( + CAssign (CReg node) + (CVal (CIndex + (CLbl (mkClosureTblLabel tycon) PtrRep) + dyn_tag PtrRep) PtrRep)) + (\ sequel -> mkDynamicAlgReturnCode tycon dyn_tag sequel) + where + dyn_tag = CTemp (mkBuiltinUnique 0) IntRep + -- + -- if you're reading this code in the attempt to figure + -- out why the compiler panic'ed here, it is probably because + -- you used tagToEnum# in a non-monomorphic setting, e.g., + -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x# + -- + -- That won't work. + -- + (Just (tycon,_)) = splitTyConApp_maybe res_ty + + +cgExpr x@(StgPrimApp op args res_ty) + | primOpOutOfLine op = tailCallPrimOp op args + | otherwise + = ASSERT(op /= SeqOp) -- can't handle SeqOp + + getArgAmodes args `thenFC` \ arg_amodes -> case (getPrimOpResultInfo op) of ReturnsPrim kind -> - performReturn do_before_stack_cleanup - (\ sequel -> robustifySequel may_gc sequel - `thenFC` \ (ret_asst, sequel') -> - absC (ret_asst `mkAbsCStmts` do_just_before_jump) - `thenC` - mkPrimReturnCode sequel') - live_vars - - ReturnsAlg tycon -> - profCtrC SLIT("RET_NEW_IN_REGS") [num_of_fields] `thenC` - - performReturn do_before_stack_cleanup - (\ sequel -> robustifySequel may_gc sequel - `thenFC` \ (ret_asst, sequel') -> - absC (mkAbstractCs [ret_asst, - do_just_before_jump, - info_ptr_assign]) - -- Must load info ptr here, not in do_just_before_stack_cleanup, - -- because the info-ptr reg clashes with argument registers - -- for the primop - `thenC` - mkDynamicAlgReturnCode tycon dyn_tag sequel') - live_vars - where - - -- Here, the destination _can_ be an update frame, so we need to make sure that - -- infoptr (R2) is loaded with the constructor's info ptr. - - info_ptr_assign = CAssign (CReg infoptr) info_lbl - - info_lbl - = case (ctrlReturnConvAlg tycon) of - VectoredReturn _ -> vec_lbl - UnvectoredReturn _ -> dir_lbl - - vec_lbl = CTableEntry (CLbl (mkInfoTableVecTblLabel tycon) DataPtrRep) - dyn_tag DataPtrRep - - data_con = head (getTyConDataCons tycon) - - (dir_lbl, num_of_fields) - = case (dataReturnConvAlg fake_isw_chkr data_con) of - ReturnInRegs rs - -> (CLbl (mkPhantomInfoTableLabel data_con) DataPtrRep, - mkIntCLit (length rs)) -- for ticky-ticky only - - ReturnInHeap - -> pprPanic "CgExpr: can't return prim in heap:" (ppr PprDebug data_con) - -- Never used, and no point in generating - -- the code for it! - - fake_isw_chkr x = Nothing - where - -- for all PrimOps except ccalls, we pin the liveness info - -- on as the first "argument" - -- ToDo: un-duplicate? - - pin_liveness (CCallOp _ _ _ _ _) _ args = args - pin_liveness other_op liveness_arg args - = liveness_arg :args - - -- We only need to worry about the sequel when we may GC and the - -- sequel is OnStack. If that's the case, arrange to pull the - -- sequel out into RetReg before performing the primOp. - - robustifySequel True sequel@(OnStack _) = - sequelToAmode sequel `thenFC` \ amode -> - returnFC (CAssign (CReg RetReg) amode, InRetReg) - robustifySequel _ sequel = returnFC (AbsCNop, sequel) + let result_amode = CReg (dataReturnConvPrim kind) in + performReturn + (COpStmt [result_amode] op arg_amodes [{-no vol_regs-}]) + (mkPrimReturnCode (text "primapp)" <+> ppr x)) + + -- otherwise, must be returning an enumerated type (eg. Bool). + -- we've only got the tag in R2, so we have to load the constructor + -- itself into R1. + + ReturnsAlg tycon + | isUnboxedTupleTyCon tycon -> primRetUnboxedTuple op args res_ty + + | isEnumerationTyCon tycon -> + performReturn + (COpStmt [dyn_tag] op arg_amodes [{-no vol_regs-}]) + (\ sequel -> + absC (CAssign (CReg node) closure_lbl) `thenC` + mkDynamicAlgReturnCode tycon dyn_tag sequel) + + where + -- Pull a unique out of thin air to put the tag in. + -- It shouldn't matter if this overlaps with anything - we're + -- about to return anyway. + dyn_tag = CTemp (mkBuiltinUnique 0) IntRep + + closure_lbl = CVal (CIndex + (CLbl (mkClosureTblLabel tycon) PtrRep) + dyn_tag PtrRep) PtrRep + \end{code} %******************************************************** @@ -214,8 +197,8 @@ Case-expression conversion is complicated enough to have its own module, @CgCase@. \begin{code} -cgExpr (StgCase expr live_vars save_vars uniq alts) - = cgCase expr live_vars save_vars uniq alts +cgExpr (StgCase expr live_vars save_vars bndr srt alts) + = cgCase expr live_vars save_vars bndr srt alts \end{code} @@ -247,8 +230,8 @@ cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body) nukeDeadBindings live_in_whole_let `thenC` saveVolatileVarsAndRegs live_in_rhss `thenFC` \ (save_assts, rhs_eob_info, maybe_cc_slot) -> - - -- ToDo: cost centre??? + -- ToDo: cost centre??? + restoreCurrentCostCentre maybe_cc_slot `thenFC` \ restore_cc -> -- Save those variables right now! absC save_assts `thenC` @@ -267,34 +250,20 @@ cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body) %* SCC Expressions * %* * %******************************************************** -\subsection[scc-codegen]{Converting StgSCC} SCC expressions are treated specially. They set the current cost centre. - -For evaluation scoping we also need to save the cost centre in an -``restore CC frame''. We only need to do this once before setting all -nested SCCs. - \begin{code} -cgExpr scc_expr@(StgSCC ty cc expr) = cgSccExpr scc_expr +cgExpr (StgSCC cc expr) + = ASSERT(sccAbleCostCentre cc) + costCentresC + SLIT("SET_CCC") + [mkCCostCentre cc, mkIntCLit (if isSccCountCostCentre cc then 1 else 0)] + `thenC` + cgExpr expr \end{code} -@cgSccExpr@ (also used in \tr{CgClosure}): -We *don't* set the cost centre for CAF/Dict cost centres -[Likewise Subsumed and NoCostCentre, but they probably -don't exist in an StgSCC expression.] -\begin{code} -cgSccExpr (StgSCC ty cc expr) - = (if setToAbleCostCentre cc then - costCentresC SLIT("SET_CCC") - [mkCCostCentre cc, mkIntCLit (if isDupdCC cc then 1 else 0)] - else - nopC) `thenC` - cgSccExpr expr -cgSccExpr other - = cgExpr other -\end{code} +ToDo: counting of dict sccs ... %******************************************************** %* * @@ -303,9 +272,6 @@ cgSccExpr other %******************************************************** \subsection[non-top-level-bindings]{Converting non-top-level bindings} -@cgBinding@ is only used for let/letrec, not for unboxed bindings. -So the kind should always be @PtrRep@. - We rely on the support code in @CgCon@ (to do constructors) and in @CgClosure@ (to do closures). @@ -314,86 +280,196 @@ cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo) -- the Id is passed along so a binding can be set up cgRhs name (StgRhsCon maybe_cc con args) - = getAtomAmodes args `thenFC` \ amodes -> - buildDynCon name maybe_cc con amodes (all zero_size args) - `thenFC` \ idinfo -> + = getArgAmodes args `thenFC` \ amodes -> + buildDynCon name maybe_cc con amodes `thenFC` \ idinfo -> returnFC (name, idinfo) - where - zero_size atom = getPrimRepSize (getArgPrimRep atom) == 0 -cgRhs name (StgRhsClosure cc bi fvs upd_flag args body) - = cgRhsClosure name cc bi fvs args body lf_info +cgRhs name (StgRhsClosure cc bi srt@(NoSRT) fvs upd_flag args body) + = mkRhsClosure name cc bi srt fvs upd_flag args body +cgRhs name (StgRhsClosure cc bi srt@(SRT _ _) fvs upd_flag args body) + = mkRhsClosure name cc bi srt fvs upd_flag args body +\end{code} + +mkRhsClosure looks for two special forms of the right-hand side: + a) selector thunks. + b) AP thunks + +If neither happens, it just calls mkClosureLFInfo. You might think +that mkClosureLFInfo should do all this, but it seems wrong for the +latter to look at the structure of an expression + +Selectors +~~~~~~~~~ +We look at the body of the closure to see if it's a selector---turgid, +but nothing deep. We are looking for a closure of {\em exactly} the +form: + +... = [the_fv] \ u [] -> + case the_fv of + con a_1 ... a_n -> a_i + + +\begin{code} +mkRhsClosure bndr cc bi srt + [the_fv] -- Just one free var + upd_flag -- Updatable thunk + [] -- A thunk + body@(StgCase (StgApp scrutinee [{-no args-}]) + _ _ _ _ -- ignore uniq, etc. + (StgAlgAlts case_ty + [(con, params, use_mask, + (StgApp selectee [{-no args-}]))] + StgNoDefault)) + | the_fv == scrutinee -- Scrutinee is the only free variable + && maybeToBool maybe_offset -- Selectee is a component of the tuple + && offset_into_int <= mAX_SPEC_SELECTEE_SIZE -- Offset is small enough + = ASSERT(is_single_constructor) + cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv] where - lf_info = mkClosureLFInfo False{-not top level-} fvs upd_flag args body + lf_info = mkSelectorLFInfo (idType bndr) offset_into_int + (isUpdatable upd_flag) + (_, params_w_offsets) = layOutDynCon con idPrimRep params + maybe_offset = assocMaybe params_w_offsets selectee + Just the_offset = maybe_offset + offset_into_int = the_offset - fixedHdrSize + is_single_constructor = maybeToBool (maybeTyConSingleCon tycon) + tycon = dataConTyCon con +\end{code} + + +Ap thunks +~~~~~~~~~ + +A more generic AP thunk of the form + + x = [ x_1...x_n ] \.. [] -> x_1 ... x_n + +A set of these is compiled statically into the RTS, so we just use +those. We could extend the idea to thunks where some of the x_i are +global ids (and hence not free variables), but this would entail +generating a larger thunk. It might be an option for non-optimising +compilation, though. + +We only generate an Ap thunk if all the free variables are pointers, +for semi-obvious reasons. + +\begin{code} +mkRhsClosure bndr cc bi srt + fvs + upd_flag + [] -- No args; a thunk + body@(StgApp fun_id args) + + | length args + 1 == arity + && all isFollowableRep (map idPrimRep fvs) + && isUpdatable upd_flag + && arity <= mAX_SPEC_AP_SIZE + + -- Ha! an Ap thunk + = cgStdRhsClosure bndr cc bi fvs [] body lf_info payload + + where + lf_info = mkApLFInfo (idType bndr) upd_flag arity + -- the payload has to be in the correct order, hence we can't + -- just use the fvs. + payload = StgVarArg fun_id : args + arity = length fvs \end{code} +The default case +~~~~~~~~~~~~~~~~ +\begin{code} +mkRhsClosure bndr cc bi srt fvs upd_flag args body + = getSRTLabel `thenFC` \ srt_label -> + let lf_info = + mkClosureLFInfo bndr NotTopLevel fvs upd_flag args srt_label srt + in + cgRhsClosure bndr cc bi fvs args body lf_info +\end{code} + + +%******************************************************** +%* * +%* Let-no-escape bindings +%* * +%******************************************************** \begin{code} cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgNonRec binder rhs) - = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot binder rhs + = cgLetNoEscapeRhs live_in_rhss rhs_eob_info maybe_cc_slot + NonRecursive binder rhs `thenFC` \ (binder, info) -> addBindC binder info cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs) = fixC (\ new_bindings -> addBindsC new_bindings `thenC` - listFCs [ cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info - maybe_cc_slot b e | (b,e) <- pairs ] + listFCs [ cgLetNoEscapeRhs full_live_in_rhss + rhs_eob_info maybe_cc_slot Recursive b e + | (b,e) <- pairs ] ) `thenFC` \ new_bindings -> addBindsC new_bindings where -- We add the binders to the live-in-rhss set so that we don't -- delete the bindings for the binder from the environment! - full_live_in_rhss = live_in_rhss `unionUniqSets` (mkUniqSet [b | (b,r) <- pairs]) + full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs]) cgLetNoEscapeRhs :: StgLiveVars -- Live in rhss -> EndOfBlockInfo - -> Maybe VirtualSpBOffset + -> Maybe VirtualSpOffset + -> RecFlag -> Id -> StgRhs -> FCode (Id, CgIdInfo) -cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder - (StgRhsClosure cc bi _ upd_flag args body) +cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder + (StgRhsClosure cc bi srt _ upd_flag args body) = -- We could check the update flag, but currently we don't switch it off -- for let-no-escaped things, so we omit the check too! -- case upd_flag of -- Updatable -> panic "cgLetNoEscapeRhs" -- Nothing to update! -- other -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body - cgLetNoEscapeClosure binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot args body + cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info maybe_cc_slot rec args body -- 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! -cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot binder +cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder (StgRhsCon cc con args) - = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} full_live_in_rhss rhs_eob_info maybe_cc_slot + = cgLetNoEscapeClosure binder cc stgArgOcc{-safe-} NoSRT full_live_in_rhss rhs_eob_info maybe_cc_slot rec [] --No args; the binder is data structure, not a function - (StgCon con args full_live_in_rhss) + (StgConApp con args) \end{code} -Some PrimOps require a {\em fixed} amount of heap allocation. Rather -than tidy away ready for GC and do a full heap check, we simply -allocate a completely uninitialised block in-line, just like any other -thunk/constructor allocation, and pass it to the PrimOp as its first -argument. Remember! The PrimOp is entirely responsible for -initialising the object. In particular, the PrimOp had better not -trigger GC before it has filled it in, and even then it had better -make sure that the GC can find the object somehow. +Little helper for primitives that return unboxed tuples. -Main current use: allocating SynchVars. \begin{code} -getPrimOpArgAmodes op args - = getAtomAmodes args `thenFC` \ arg_amodes -> - - case primOpHeapReq op of - - FixedHeapRequired size -> allocHeap size `thenFC` \ amode -> - returnFC (amode : arg_amodes) - - _ -> returnFC arg_amodes +primRetUnboxedTuple :: PrimOp -> [StgArg] -> Type -> Code +primRetUnboxedTuple op args res_ty + = getArgAmodes args `thenFC` \ arg_amodes -> + {- + put all the arguments in temporaries so they don't get stomped when + we push the return address. + -} + let + n_args = length args + arg_uniqs = map mkBuiltinUnique [0 .. n_args-1] + arg_reps = map getArgPrimRep args + arg_temps = zipWith CTemp arg_uniqs arg_reps + in + absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC` + {- + allocate some temporaries for the return values. + -} + let + (tc,ty_args) = case splitTyConApp_maybe (repType res_ty) of + Nothing -> pprPanic "primRetUnboxedTuple" (ppr res_ty) + Just pr -> pr + prim_reps = map typePrimRep ty_args + temp_uniqs = map mkBuiltinUnique [ n_args .. n_args + length ty_args - 1] + temp_amodes = zipWith CTemp temp_uniqs prim_reps + in + returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps [])) \end{code} - -