[commit: ghc] master: Don't generate a prototype for cas (4085904)
Ian Lynagh
igloo at earth.li
Wed Apr 20 02:51:52 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/40859045bf3e74efb5443b407bb01978e742e49d
>---------------------------------------------------------------
commit 40859045bf3e74efb5443b407bb01978e742e49d
Author: Ian Lynagh <igloo at earth.li>
Date: Tue Apr 19 23:51:19 2011 +0100
Don't generate a prototype for cas
I'm not sure if this is the best way to fix this, but it fixes the
unreg build.
>---------------------------------------------------------------
compiler/cmm/CLabel.hs | 12 ++++++++++--
compiler/cmm/PprC.hs | 2 +-
2 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index c151a26..901b13b 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -101,7 +101,7 @@ module CLabel (
hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
- isMathFun,
+ isMathFun, isCas,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
pprCLabel
@@ -590,9 +590,17 @@ maybeAsmTemp (AsmTempLabel uq) = Just uq
maybeAsmTemp _ = Nothing
+-- | Check whether a label corresponds to our cas function.
+-- We #include the prototype for this, so we need to avoid
+-- generating out own C prototypes.
+isCas :: CLabel -> Bool
+isCas (CmmLabel pkgId fn _) = pkgId == rtsPackageId && fn == fsLit "cas"
+isCas _ = False
+
+
-- | Check whether a label corresponds to a C function that has
-- a prototype in a system header somehere, or is built-in
--- to the C compiler. For these labels we abovoid generating our
+-- to the C compiler. For these labels we avoid generating our
-- own C prototypes.
isMathFun :: CLabel -> Bool
isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 10f4e8b..d363cef 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -248,7 +248,7 @@ pprStmt stmt = case stmt of
| CmmNeverReturns <- ret ->
let myCall = pprCall (pprCLabel lbl) cconv results args safety
in (real_fun_proto lbl, myCall)
- | not (isMathFun lbl) ->
+ | not (isMathFun lbl || isCas lbl) ->
let myCall = braces (
pprCFunType (char '*' <> text "ghcFunPtr") cconv results args <> semi
$$ text "ghcFunPtr" <+> equals <+> cast_fn <> semi
More information about the Cvs-ghc
mailing list