[project @ 2005-11-02 11:56:56 by simonmar]

[ghc-hetmet.git] / ghc / compiler / cmm / PprC.hs

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index 10d4da2..7427f50 100644 (file)
--- a/ghc/compiler/cmm/PprC.hs
+++ b/ghc/compiler/cmm/PprC.hs
@@ -69,8 +69,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 +183,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 +303,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
@@ -366,8 +372,8 @@ pprLit :: CmmLit -> SDoc
 pprLit lit = case lit of
     CmmInt i rep      -> pprHexVal i rep
     CmmFloat f rep     -> parens (machRepCType rep) <> (rational f)
-    CmmLabel clbl      -> mkW_ <> pprCLabel clbl
-    CmmLabelOff clbl i -> mkW_ <> pprCLabel clbl <> char '+' <> int i
+    CmmLabel clbl      -> mkW_ <> pprCLabelAddr clbl
+    CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i
     CmmLabelDiffOff clbl1 clbl2 i
         -- WARNING:
         --  * the lit must occur in the info table clbl2
@@ -375,7 +381,9 @@ pprLit lit = case lit of
         -- The Mangler is expected to convert any reference to an SRT,
         -- a slow entry point or a large bitmap
         -- from an info table to an offset.
-        -> mkW_ <> pprCLabel clbl1 <> char '+' <> int i
+        -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i
+
+pprCLabelAddr lbl = char '&' <> pprCLabel lbl
 
 pprLit1 :: CmmLit -> SDoc
 pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
@@ -646,6 +654,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.
@@ -699,7 +708,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"
 
@@ -729,9 +741,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
@@ -813,11 +826,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
@@ -983,11 +995,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