X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCLabel.hs;h=a3c2634e35a3ac594cc03dd19c05e08e91b0a203;hb=c245355e6f2c7b7c95e9af910c4d420e13af9413;hp=a67e587b4d68181c838e0a57c9151191f5c45e6c;hpb=81b2276ff9434d97aff683218c34c86479a8d868;p=ghc-hetmet.git

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index a67e587..a3c2634 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -1,3 +1,10 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 -----------------------------------------------------------------------------
 --
 -- Object-file symbols (called CLabel for histerical raisins).
@@ -82,6 +89,7 @@ module CLabel (
 	mkRtsApFastLabel,
 
 	mkForeignLabel,
+        addLabelSize,
 
 	mkCCLabel, mkCCSLabel,
 
@@ -97,6 +105,7 @@ module CLabel (
 
 	infoLblToEntryLbl, entryLblToInfoLbl,
 	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
+        isMathFun,
 	CLabelType(..), labelType, labelDynamic,
 
 	pprCLabel
@@ -317,7 +326,8 @@ mkAltLabel      uniq tag	= CaseLabel uniq (CaseAlt tag)
 mkDefaultLabel  uniq 		= CaseLabel uniq CaseDefault
 
 mkStringLitLabel		= StringLitLabel
-mkAsmTempLabel 			= AsmTempLabel
+mkAsmTempLabel :: Uniquable a => a -> CLabel
+mkAsmTempLabel a		= AsmTempLabel (getUnique a)
 
 mkModuleInitLabel :: Module -> String -> CLabel
 mkModuleInitLabel mod way        = ModuleInitLabel mod way
@@ -357,6 +367,12 @@ mkApEntryLabel upd off		= RtsLabel (RtsApEntry   upd off)
 mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
 mkForeignLabel str mb_sz  is_dynamic = ForeignLabel str mb_sz is_dynamic
 
+addLabelSize :: CLabel -> Int -> CLabel
+addLabelSize (ForeignLabel str _ is_dynamic) sz
+  = ForeignLabel str (Just sz) is_dynamic
+addLabelSize label _
+  = label
+
 	-- Cost centres etc.
 
 mkCCLabel	cc		= CC_Label cc
@@ -447,7 +463,11 @@ needsCDecl ModuleRegdLabel		= False
 needsCDecl (StringLitLabel _)		= False
 needsCDecl (AsmTempLabel _)		= False
 needsCDecl (RtsLabel _)			= False
-needsCDecl (ForeignLabel _ _ _)		= False
+  -- RTS labels are declared in RTS header files.  Otherwise we'd need
+  -- to give types for each label reference in the RTS .cmm files
+  -- somehow; when generating .cmm code we know the types of labels (info, 
+  -- entry etc.) but for hand-written .cmm code we don't.
+needsCDecl l@(ForeignLabel _ _ _)	= not (isMathFun l)
 needsCDecl (CC_Label _)			= True
 needsCDecl (CCS_Label _)		= True
 needsCDecl (HpcTicksLabel _)            = True
@@ -463,6 +483,25 @@ maybeAsmTemp :: CLabel -> Maybe Unique
 maybeAsmTemp (AsmTempLabel uq) = Just uq
 maybeAsmTemp _ 	    	       = Nothing
 
+-- some labels have C prototypes in scope when compiling via C, because
+-- they are builtin to the C compiler.  For these labels we avoid
+-- generating our own C prototypes.
+isMathFun :: CLabel -> Bool
+isMathFun (ForeignLabel fs _ _) = fs `elem` math_funs
+  where
+  math_funs = [
+        FSLIT("pow"),    FSLIT("sin"),   FSLIT("cos"),
+        FSLIT("tan"),    FSLIT("sinh"),  FSLIT("cosh"),
+        FSLIT("tanh"),   FSLIT("asin"),  FSLIT("acos"),
+        FSLIT("atan"),   FSLIT("log"),   FSLIT("exp"),
+        FSLIT("sqrt"),   FSLIT("powf"),  FSLIT("sinf"),
+        FSLIT("cosf"),   FSLIT("tanf"),  FSLIT("sinhf"),
+        FSLIT("coshf"),  FSLIT("tanhf"), FSLIT("asinf"),
+        FSLIT("acosf"),  FSLIT("atanf"), FSLIT("logf"),
+        FSLIT("expf"),   FSLIT("sqrtf")
+   ]
+isMathFun _ = False
+
 -- -----------------------------------------------------------------------------
 -- Is a CLabel visible outside this object file or not?