[project @ 1999-10-31 15:35:32 by sof]

To workaround gcc/egcs bugs re: handling of non-toplevel "extern" decls,
lift them out to the top. i.e., extend mechanism by which "typedefs"
are lifted out to the toplevel (for the same reasons) to also encompass
"extern"s.

Note: the default is not to emit an "extern" decl for every _ccall_,
as this runs the chance of (trivially) conflicting with header file
includes. So, to enable, use -optC-femit-extern-decls.

3 files changed, 14 insertions, 7 deletions

diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index 90f678d24b..cb65a7f239 100644
--- a/ghc/compiler/absCSyn/AbsCSyn.lhs
+++ b/ghc/compiler/absCSyn/AbsCSyn.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: AbsCSyn.lhs,v 1.24 1999/06/24 13:04:13 simonmar Exp $
+% $Id: AbsCSyn.lhs,v 1.25 1999/10/31 15:35:32 sof Exp $
 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 
@@ -166,7 +166,8 @@ stored in a mixed type location.)
        typedefs if needs be (i.e., when generating .hc code and
        compiling 'foreign import dynamic's)
     -}
-  | CCallTypedef        PrimOp{-CCallOp-} [CAddrMode] [CAddrMode]
+  | CCallTypedef Bool {- True => use "typedef"; False => use "extern"-}
+  		 PrimOp{-CCallOp-} [CAddrMode] [CAddrMode]
 
   -- *** the next three [or so...] are DATA (those above are CODE) ***
 
diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index c6ccb506ec..ac795f727c 100644
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -27,7 +27,7 @@ import PrimRep		( getPrimRepSize, PrimRep(..) )
 import Unique		( Unique{-instance Eq-} )
 import UniqSupply	( uniqFromSupply, uniqsFromSupply, splitUniqSupply, 
 			  UniqSupply )
-import CmdLineOpts      ( opt_ProduceC )
+import CmdLineOpts      ( opt_ProduceC, opt_EmitCExternDecls )
 import Maybes		( maybeToBool )
 import PrimOp		( PrimOp(..) )
 import Panic		( panic )
@@ -329,11 +329,17 @@ flatAbsC (CSwitch discrim alts deflt)
       = flatAbsC absC	`thenFlt` \ (alt_heres, alt_tops) ->
 	returnFlt ( (tag, alt_heres), alt_tops )
 
-flatAbsC stmt@(COpStmt results td@(CCallOp (Right _) _ _ _) args vol_regs)
-  | maybeToBool opt_ProduceC
+flatAbsC stmt@(COpStmt results td@(CCallOp _ _ _ _) args vol_regs)
+  | isCandidate && maybeToBool opt_ProduceC
   = returnFlt (stmt, tdef)
   where
-    tdef = CCallTypedef td results args
+    (isCandidate, isDyn) =
+      case td of 
+        CCallOp (Right _) _ _ _      -> (True, True)
+	CCallOp (Left _) is_asm _ _  -> (opt_EmitCExternDecls && not is_asm, False)
+        _			     -> (False, False)
+
+    tdef = CCallTypedef isDyn td results args
 
 flatAbsC stmt@(CSimultaneous abs_c)
   = flatAbsC abs_c		`thenFlt` \ (stmts_here, tops) ->
diff --git a/ghc/compiler/absCSyn/CallConv.lhs b/ghc/compiler/absCSyn/CallConv.lhs
index 712a241c20..e38fc460b0 100644
--- a/ghc/compiler/absCSyn/CallConv.lhs
+++ b/ghc/compiler/absCSyn/CallConv.lhs
@@ -53,7 +53,7 @@ platforms.
 \begin{code}
 callConvAttribute :: CallConv -> String
 callConvAttribute cc
- | cc == stdCallConv   = "__attribute__((stdcall))"
+ | cc == stdCallConv   = "__stdcall"
  | cc == cCallConv     = ""
  | otherwise	       = panic ("callConvAttribute: cannot handle" ++ showSDoc (pprCallConv cc))