%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgCase.lhs,v 1.66 2003/07/22 16:11:26 simonmar Exp $
+% $Id: CgCase.lhs,v 1.67 2004/08/09 13:19:29 simonmar Exp $
%
%********************************************************
%* *
)
import TyCon ( TyCon, isEnumerationTyCon, tyConPrimRep )
import Unique ( Unique, Uniquable(..), newTagUnique )
+import ForeignCall
import Util ( only )
import List ( sortBy )
import Outputable
bindNewToTemp bndr `thenFC` \ tmp_amode ->
absC (CAssign tmp_amode amode) `thenC`
cgPrimAlts NoGC tmp_amode alts alt_type
-\end{code}
+\end{code}
-Special case #3: inline PrimOps.
+Special case #3: inline PrimOps and foreign calls.
\begin{code}
-cgCase (StgOpApp op@(StgPrimOp primop) args _)
+cgCase (StgOpApp op args _)
live_in_whole_case live_in_alts bndr srt alt_type alts
- | not (primOpOutOfLine primop)
+ | inline_primop
= -- Get amodes for the arguments and results
getArgAmodes args `thenFC` \ arg_amodes ->
getVolatileRegs live_in_alts `thenFC` \ vol_regs ->
[(_, 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
-- Do the switch
absC (mkAlgAltsCSwitch tag_amode tagged_alts)
- where
- 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)
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
+
\end{code}
TODO: Case-of-case of primop can probably be done inline too (but