- | inline_primop
- = -- Get amodes for the arguments and results
- getArgAmodes args `thenFC` \ arg_amodes ->
- getVolatileRegs live_in_alts `thenFC` \ vol_regs ->
-
- case alt_type of
- PrimAlt tycon -- PRIMITIVE ALTS
- -> bindNewToTemp bndr `thenFC` \ tmp_amode ->
- absC (COpStmt [tmp_amode] op arg_amodes vol_regs) `thenC`
- -- Note: no liveness arg
- cgPrimAlts NoGC tmp_amode alts alt_type
-
- UbxTupAlt tycon -- UNBOXED TUPLE ALTS
- -> -- No heap check, no yield, just get in there and do it.
- -- NB: the case binder isn't bound to anything;
- -- it has a unboxed tuple type
- mapFCs bindNewToTemp res_ids `thenFC` \ res_tmps ->
- absC (COpStmt res_tmps op arg_amodes vol_regs) `thenC`
- cgExpr rhs
- where
- [(_, res_ids, _, rhs)] = alts
-
- AlgAlt tycon -- ENUMERATION TYPE RETURN
- | StgPrimOp primop <- op
- -> ASSERT( isEnumerationTyCon tycon )
- let
- do_enum_primop :: PrimOp -> FCode CAddrMode -- Returns amode for result
- do_enum_primop TagToEnumOp -- No code!
- = returnFC (only arg_amodes)
-
- do_enum_primop primop
- = absC (COpStmt [tag_amode] op arg_amodes vol_regs) `thenC`
- returnFC tag_amode
- where
- tag_amode = CTemp (newTagUnique (getUnique bndr) 'C') IntRep
- -- Being a bit short of uniques for temporary
- -- variables here, we use newTagUnique to
- -- generate a new unique from the case binder.
- -- The case binder's unique will presumably
- -- have the 'c' tag (generated by CoreToStg),
- -- so we just change its tag to 'C' (for
- -- 'case') to ensure it doesn't clash with
- -- anything else. We can't use the unique
- -- from the case binder, becaus e this is used
- -- to hold the actual result closure (via the
- -- call to bindNewToTemp)
- in
- do_enum_primop primop `thenFC` \ tag_amode ->
-
- -- Bind the default binder if necessary
- -- (avoiding it avoids the assignment)
- -- The deadness info is set by StgVarInfo
- (if (isDeadBinder bndr)
- then nopC
- else bindNewToTemp bndr `thenFC` \ tmp_amode ->
- absC (CAssign tmp_amode (tagToClosure tycon tag_amode))
- ) `thenC`
-
- -- Compile the alts
- cgAlgAlts NoGC (getUnique bndr)
- Nothing{-cc_slot-} False{-no semi-tagging-}
- (AlgAlt tycon) alts `thenFC` \ tagged_alts ->
-
- -- Do the switch
- absC (mkAlgAltsCSwitch tag_amode tagged_alts)
-
- other -> pprPanic "cgCase: case of primop has strange alt type" (ppr alt_type)
- where
- inline_primop = case op of
- StgPrimOp primop -> not (primOpOutOfLine primop)
- StgFCallOp (CCall (CCallSpec _ _ PlayRisky)) _ -> True
- -- unsafe foreign calls are "inline"
- _otherwise -> False
-