[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.

diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs
index 90f678d..cb65a7f 100644 (file)
--- 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 c6ccb50..ac795f7 100644 (file)
--- 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 712a241..e38fc46 100644 (file)
--- 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))