[project @ 2004-08-09 13:19:29 by simonmar]

Allow case-of-unsafe-ccall to compile to straight-line code, like it
used to.  This has already been fixed on the backend-hacking-branch,
but I'm doing it here so that it can be merged into the STABLE branch,
where it will help to work around a bug.

The bug is in CgExpr.lhs:primRetUnboxedTuple, which picks temporaries
to assign the result of a ccall to.  The Cg monad doesn't have a uniq
supply (in the HEAD), so we always pick the same temporaries.  This
leads to clashes in complex function with multiple ccalls.  Again,
this is already fixed in the backend-hacking-branch.  I don't see an
easy fix for this bug.

The compilation of case-of-unsafe-ccall doesn't suffer from this
problem, and it will help work around some cases of the bug, so I'm
going to merge this onto the STABLE branch after some testing.

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index af053f6..d313839 100644 (file)
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (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 $
 %
 %********************************************************
 %*                                                     *
@@ -53,6 +53,7 @@ import PrimRep                ( getPrimRepSize, retPrimRepSize, PrimRep(..)
                        )
 import TyCon           ( TyCon, isEnumerationTyCon, tyConPrimRep       )
 import Unique           ( Unique, Uniquable(..), newTagUnique )
+import ForeignCall
 import Util            ( only )
 import List            ( sortBy )
 import Outputable
@@ -145,14 +146,14 @@ cgCase (StgApp v []) live_in_whole_case live_in_alts bndr srt
     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 ->
@@ -175,7 +176,30 @@ cgCase (StgOpApp op@(StgPrimOp primop) args _)
           [(_, 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
@@ -194,27 +218,15 @@ cgCase (StgOpApp op@(StgPrimOp primop) args _)
 
                -- 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