[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