- getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
- let
- result_amodes = getPrimAppResultAmodes uniq alts
- liveness_mask = panic "cgCase: liveness of non-GC-ing primop touched\n"
- in
- -- Perform the operation
- getVolatileRegs live_in_alts `thenFC` \ vol_regs ->
-
- -- seq cannot happen here => no additional B Stack alloc
-
- absC (COpStmt result_amodes op
- arg_amodes -- note: no liveness arg
- liveness_mask vol_regs) `thenC`
-
- -- Scrutinise the result
- cgInlineAlts NoGC uniq alts
-
- | otherwise -- *Can* trigger GC
- = getPrimOpArgAmodes op args `thenFC` \ arg_amodes ->
-
- -- Get amodes for the arguments and results, and assign to regs
- -- (Can-trigger-gc primops guarantee to have their (nonRobust)
- -- args in regs)
- let
- op_result_regs = assignPrimOpResultRegs op
-
- op_result_amodes = map CReg op_result_regs
-
- (op_arg_amodes, liveness_mask, arg_assts)
- = makePrimOpArgsRobust op arg_amodes
-
- liveness_arg = mkIntCLit liveness_mask
- in
- -- Tidy up in case GC happens...
-
- -- Nota Bene the use of live_in_whole_case in nukeDeadBindings.
- -- Reason: the arg_assts computed above may refer to some stack slots
- -- which are not live in the alts. So we mustn't use those slots
- -- to save volatile vars in!
- nukeDeadBindings live_in_whole_case `thenC`
- saveVolatileVars live_in_alts `thenFC` \ volatile_var_save_assts ->
-
- -- Allocate stack words for the prim-op itself,
- -- these are guaranteed to be ON TOP OF the stack.
- -- Currently this is used *only* by the seq# primitive op.
- let
- (a_req,b_req) = case (primOpStackRequired op) of
- NoStackRequired -> (0, 0)
- FixedStackRequired a b -> (a, b)
- VariableStackRequired -> (0, 0) -- i.e. don't care
- in
- allocAStackTop a_req `thenFC` \ a_slot ->
- allocBStackTop b_req `thenFC` \ b_slot ->
-
- getEndOfBlockInfo `thenFC` \ eob_info@(EndOfBlockInfo args_spa args_spb sequel) ->
- -- a_req and b_req allocate stack space that is taken care of by the
- -- macros generated for the primops; thus, we there is no need to adjust
- -- this part of the stacks later on (=> +a_req in EndOfBlockInfo)
- -- currently all this is only used for SeqOp
- forkEval (if True {- a_req==0 && b_req==0 -}
- then eob_info
- else (EndOfBlockInfo (args_spa+a_req)
- (args_spb+b_req) sequel)) nopC
- (
- getAbsC (cgInlineAlts GCMayHappen uniq alts) `thenFC` \ abs_c ->
- absC (CRetUnVector vtbl_label (CLabelledCode return_label abs_c))
- `thenC`
- returnFC (CaseAlts (CUnVecLbl return_label vtbl_label)
- Nothing{-no semi-tagging-}))
- `thenFC` \ new_eob_info ->
-
- -- Record the continuation info
- setEndOfBlockInfo new_eob_info (
-
- -- Now "return" to the inline alternatives; this will get
- -- compiled to a fall-through.
- let
- simultaneous_assts = arg_assts `mkAbsCStmts` volatile_var_save_assts
-
- -- do_op_and_continue will be passed an amode for the continuation
- do_op_and_continue sequel
- = absC (COpStmt op_result_amodes
- op
- (pin_liveness op liveness_arg op_arg_amodes)
- liveness_mask
- [{-no vol_regs-}])
- `thenC`
-
- sequelToAmode sequel `thenFC` \ dest_amode ->
- absC (CReturn dest_amode DirectReturn)
-
- -- Note: we CJump even for algebraic data types,
- -- because cgInlineAlts always generates code, never a
- -- vector.
- in
- performReturn simultaneous_assts do_op_and_continue live_in_alts
- )
- 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
-
- vtbl_label = mkVecTblLabel uniq
- return_label = mkReturnPtLabel uniq
-
+ getArgAmodes args `thenFC` \ arg_amodes ->
+ getVolatileRegs live_in_alts `thenFC` \ vol_regs ->
+
+ case alts of
+ StgPrimAlts tycon alts deflt -- PRIMITIVE ALTS
+ -> absC (COpStmt [CTemp (getUnique bndr) (tyConPrimRep tycon)]
+ op
+ arg_amodes -- note: no liveness arg
+ vol_regs) `thenC`
+ cgPrimInlineAlts bndr tycon alts deflt
+
+ StgAlgAlts (Just tycon) [(_, args, _, rhs)] StgNoDefault
+ | isUnboxedTupleTyCon tycon -- UNBOXED TUPLE ALTS
+ -> -- no heap check, no yield, just get in there and do it.
+ absC (COpStmt [ CTemp (getUnique arg) (idPrimRep arg) | arg <- args ]
+ op
+ arg_amodes -- note: no liveness arg
+ vol_regs) `thenC`
+ mapFCs bindNewToTemp args `thenFC` \ _ ->
+ cgExpr rhs
+
+ other -> pprPanic "cgCase: case of primop has strange alts" (pprStgAlts alts)