X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fcmm%2FPprC.hs;h=9fece36a427c634d7d33e1ad1c89a5fb1eb051a1;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=7804fb680f71604bf8e8c4bec038b7f6b34d4cd9;hpb=b0cfcc189e7280a1f18cdead8b875e4c42db5df0;p=ghc-hetmet.git

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index 7804fb6..9fece36 100644
--- a/ghc/compiler/cmm/PprC.hs
+++ b/ghc/compiler/cmm/PprC.hs
@@ -45,6 +45,7 @@ import Data.Bits        ( shiftR )
 import Char             ( ord, chr )
 import IO               ( Handle )
 import DATA_BITS
+import Data.Word	( Word8 )
 
 #ifdef DEBUG
 import PprCmm		() -- instances only
@@ -69,8 +70,7 @@ pprCs dflags cmms
 
 writeCs :: DynFlags -> Handle -> [Cmm] -> IO ()
 writeCs dflags handle cmms 
-  = printForUser handle alwaysQualify (pprCs dflags cmms)
- 	-- ToDo: should be printForC
+  = printForC handle (pprCs dflags cmms)
 
 -- --------------------------------------------------------------------------
 -- Now do some real work
@@ -184,6 +184,10 @@ pprStmt stmt = case stmt of
 	-> ptext SLIT("ASSIGN_Word64") <> 
 		parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
 
+	| rep == F64 && wordRep /= I64
+	-> ptext SLIT("ASSIGN_DBL") <> 
+		parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
+
  	| otherwise
 	-> hsep [ pprExpr (CmmLoad dest rep), equals, pprExpr src <> semi ]
 	where
@@ -300,6 +304,9 @@ pprExpr e = case e of
     CmmLoad e I64 | wordRep /= I64
 	-> ptext SLIT("PK_Word64") <> parens (mkP_ <> pprExpr1 e)
 
+    CmmLoad e F64 | wordRep /= I64
+	-> ptext SLIT("PK_DBL") <> parens (mkP_ <> pprExpr1 e)
+
     CmmLoad (CmmReg r) rep 
 	| isPtrReg r && rep == wordRep
 	-> char '*' <> pprAsPtrReg r
@@ -648,6 +655,7 @@ isStrangeTypeGlobal r 			= isPtrGlobalReg r
 strangeRegType :: CmmReg -> Maybe SDoc
 strangeRegType (CmmGlobal CurrentTSO) = Just (ptext SLIT("struct StgTSO_ *"))
 strangeRegType (CmmGlobal CurrentNursery) = Just (ptext SLIT("struct bdescr_ *"))
+strangeRegType (CmmGlobal BaseReg) = Just (ptext SLIT("struct StgRegTable_ *"))
 strangeRegType _ = Nothing
 
 -- pprReg just prints the register name.
@@ -701,7 +709,10 @@ pprCall ppr_fn cconv results args vols
   where 
      ppr_results []     = empty
      ppr_results [(one,hint)] 
-	 = pprExpr (CmmReg one) <> ptext SLIT(" = ")
+	 | Just ty <- strangeRegType one
+	 = pprReg one <> ptext SLIT(" = ") <> parens ty
+	 | otherwise
+	 = pprReg one <> ptext SLIT(" = ")
 		 <> pprUnHint hint (cmmRegRep one)
      ppr_results _other = panic "pprCall: multiple results"
 
@@ -731,9 +742,10 @@ pprGlobalRegName gr = case gr of
     VanillaReg n   -> char 'R' <> int n  -- without the .w suffix
     _              -> pprGlobalReg gr
 
+-- Currently we only have these two calling conventions, but this might
+-- change in the future...
 is_cish CCallConv   = True
 is_cish StdCallConv = True
-is_cish _	    = False
 
 -- ---------------------------------------------------------------------
 -- Find and print local and external declarations for a list of
@@ -815,11 +827,10 @@ te_Stmt _			= return ()
 
 te_Expr :: CmmExpr -> TE ()
 te_Expr (CmmLit lit)		= te_Lit lit
-te_Expr (CmmReg r)		= te_Reg r
 te_Expr (CmmLoad e _)		= te_Expr e
+te_Expr (CmmReg r)		= te_Reg r
 te_Expr (CmmMachOp _ es) 	= mapM_ te_Expr es
 te_Expr (CmmRegOff r _) 	= te_Reg r
-te_Expr _ 			= return ()
 
 te_Reg :: CmmReg -> TE ()
 te_Reg (CmmLocal l) = te_temp l
@@ -871,25 +882,21 @@ machRepSignedCType r | r == wordRep = ptext SLIT("I_")
 -- ---------------------------------------------------------------------
 -- print strings as valid C strings
 
--- Assumes it contains only characters '\0'..'\xFF'!
-pprFSInCStyle :: FastString -> SDoc
-pprFSInCStyle fs = pprStringInCStyle (unpackFS fs)
-
-pprStringInCStyle :: String -> SDoc
+pprStringInCStyle :: [Word8] -> SDoc
 pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
 
-charToC :: Char -> String
-charToC '\"' = "\\\""
-charToC '\'' = "\\\'"
-charToC '\\' = "\\\\"
-charToC c | c >= ' ' && c <= '~' = [c]
-          | c > '\xFF' = panic ("charToC "++show c)
-          | otherwise = ['\\',
+charToC :: Word8 -> String
+charToC w = 
+  case chr (fromIntegral w) of
+	'\"' -> "\\\""
+	'\'' -> "\\\'"
+	'\\' -> "\\\\"
+	c | c >= ' ' && c <= '~' -> [c]
+          | otherwise -> ['\\',
                          chr (ord '0' + ord c `div` 64),
                          chr (ord '0' + ord c `div` 8 `mod` 8),
                          chr (ord '0' + ord c         `mod` 8)]
 
-
 -- ---------------------------------------------------------------------------
 -- Initialising static objects with floating-point numbers.  We can't
 -- just emit the floating point number, because C will cast it to an int
@@ -985,11 +992,16 @@ pprHexVal w rep
   | otherwise = ptext SLIT("0x") <> go w <> repsuffix rep
   where
   	-- type suffix for literals:
-	-- on 32-bit platforms, add "LL" to 64-bit literals
-      repsuffix I64 | wORD_SIZE == 4 = ptext SLIT("LL")
+	-- Integer literals are unsigned in Cmm/C.  We explicitly cast to
+	-- signed values for doing signed operations, but at all other
+	-- times values are unsigned.  This also helps eliminate occasional
+	-- warnings about integer overflow from gcc.
+
+	-- on 32-bit platforms, add "ULL" to 64-bit literals
+      repsuffix I64 | wORD_SIZE == 4 = ptext SLIT("ULL")
       	-- on 64-bit platforms with 32-bit int, add "L" to 64-bit literals
-      repsuffix I64 | cINT_SIZE == 4 = ptext SLIT("L")
-      repsuffix _ = empty
+      repsuffix I64 | cINT_SIZE == 4 = ptext SLIT("UL")
+      repsuffix _ = char 'U'
       
       go 0 = empty
       go w' = go q <> dig