X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FAbsCUtils.lhs;h=8e83f7d0f65f2dd5b9eeb7add45f427c82da6fc8;hb=cc3d91e372a0bdc6e74a0e2a1fb1b27df3c636f0;hp=3a1bd476dd76dbb36ed8a858c2cb194a9cc84c87;hpb=4166dff80e8ec94022a040318ff2759913fbbe06;p=ghc-hetmet.git

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 3a1bd47..8e83f7d 100644
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -28,7 +28,8 @@ import Unique		( Unique{-instance Eq-} )
 import UniqSupply	( uniqFromSupply, uniqsFromSupply, splitUniqSupply, 
 			  UniqSupply )
 import CmdLineOpts      ( opt_EmitCExternDecls )
-import PrimOp		( PrimOp(..), CCall(..), isDynamicTarget )
+import ForeignCall	( ForeignCall(..), CCallSpec(..), isDynamicTarget, isCasmTarget )
+import StgSyn		( StgOp(..) )
 import Panic		( panic )
 import FastTypes
 
@@ -289,8 +290,8 @@ mapAndUnzipFlt f (x:xs)
 getUniqFlt :: FlatM Unique
 getUniqFlt us = uniqFromSupply us
 
-getUniqsFlt :: Int -> FlatM [Unique]
-getUniqsFlt i us = uniqsFromSupply i us
+getUniqsFlt :: FlatM [Unique]
+getUniqsFlt us = uniqsFromSupply us
 \end{code}
 
 %************************************************************************
@@ -340,16 +341,12 @@ flatAbsC (CSwitch discrim alts deflt)
       = flatAbsC absC	`thenFlt` \ (alt_heres, alt_tops) ->
 	returnFlt ( (tag, alt_heres), alt_tops )
 
-flatAbsC stmt@(COpStmt results (CCallOp ccall@(CCall target is_asm _ _)) args vol_regs)
-  | isCandidate
-  = returnFlt (stmt, tdef)
-  | otherwise
-  = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(COpStmt results (StgFCallOp (CCall ccall@(CCallSpec target _ _)) uniq) args _)
+  |  is_dynamic	 					 -- Emit a typedef if its a dynamic call
+  || (opt_EmitCExternDecls && not (isCasmTarget target)) -- or we want extern decls
+  = returnFlt (stmt, CCallTypedef is_dynamic ccall uniq results args)
   where
-    isCandidate = is_dynamic || opt_EmitCExternDecls && not is_asm
-    is_dynamic  = isDynamicTarget target
-
-    tdef = CCallTypedef is_dynamic ccall results args
+    is_dynamic = isDynamicTarget target
 
 flatAbsC stmt@(CSimultaneous abs_c)
   = flatAbsC abs_c		`thenFlt` \ (stmts_here, tops) ->
@@ -367,14 +364,14 @@ flatAbsC stmt@(CCallProfCtrMacro str amodes)
   | otherwise		 	= returnFlt (stmt, AbsCNop)
 
 -- Some statements need no flattening at all:
-flatAbsC stmt@(CMacroStmt macro amodes) 	= returnFlt (stmt, AbsCNop)
-flatAbsC stmt@(CCallProfCCMacro str amodes) 	= returnFlt (stmt, AbsCNop)
-flatAbsC stmt@(CAssign dest source) 		= returnFlt (stmt, AbsCNop)
-flatAbsC stmt@(CJump target) 			= returnFlt (stmt, AbsCNop)
-flatAbsC stmt@(CFallThrough target) 		= returnFlt (stmt, AbsCNop)
-flatAbsC stmt@(CReturn target return_info) 	= returnFlt (stmt, AbsCNop)
-flatAbsC stmt@(CInitHdr a b cc) 		= returnFlt (stmt, AbsCNop)
-flatAbsC stmt@(COpStmt results op args vol_regs)= returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(CMacroStmt macro amodes) 	 = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(CCallProfCCMacro str amodes) 	 = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(CAssign dest source) 		 = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(CJump target) 			 = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(CFallThrough target) 		 = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(CReturn target return_info) 	 = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(CInitHdr a b cc) 		 = returnFlt (stmt, AbsCNop)
+flatAbsC stmt@(COpStmt results op args vol_regs) = returnFlt (stmt, AbsCNop)
 
 -- Some statements only make sense at the top level, so we always float
 -- them.  This probably isn't necessary.
@@ -474,7 +471,7 @@ doSimultaneously1 vertices
 	    returnFlt (CAssign the_temp src, CAssign dest the_temp)
 
 	go_via_temps (COpStmt dests op srcs vol_regs)
-	  = getUniqsFlt (length dests)	`thenFlt` \ uniqs ->
+	  = getUniqsFlt			`thenFlt` \ uniqs ->
 	    let
 		the_temps = zipWith (\ u d -> CTemp u (getAmodeRep d)) uniqs dests
 	    in
@@ -494,11 +491,6 @@ doSimultaneously1 vertices
       = or [dest1 `conflictsWith` src2 | src2 <- srcs2]
     (COpStmt dests1 _ _ _) `should_follow` (COpStmt _ _ srcs2 _)
       = or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
-
---    (COpStmt _ _ _ _ _) `should_follow` (CCallProfCtrMacro _ _) = False
---    (CCallProfCtrMacro _ _) `should_follow` (COpStmt _ _ _ _ _) = False
-
-
 \end{code}