X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FPprCmm.hs;h=4ade7a40284a358c77f8dbad3940f4089df36f11;hb=bd3a364da7956c269d31645995d0d775c52f6a84;hp=6e8367d66280b3c3dce48521f0d64974dc66cccf;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 6e8367d..4ade7a4 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -2,7 +2,7 @@
 --
 -- Pretty-printing of Cmm as (a superset of) C--
 --
--- (c) The University of Glasgow 2004
+-- (c) The University of Glasgow 2004-2006
 --
 -----------------------------------------------------------------------------
 
@@ -39,19 +39,18 @@ module PprCmm (
 #include "HsVersions.h"
 
 import Cmm
-import CmmUtils     ( isTrivialCmmExpr )
-import MachOp       ( MachOp(..), pprMachOp, MachRep(..), wordRep )
-import CLabel       ( pprCLabel, mkForeignLabel, entryLblToInfoLbl )
+import CmmUtils
+import MachOp
+import CLabel
 
-import ForeignCall  ( CCallConv(..) )
-import Unique       ( getUnique )
+import ForeignCall
+import Unique
 import Outputable
-import FastString   ( mkFastString )
+import FastString
 
-import Data.List    ( intersperse, groupBy )
-import IO           ( Handle )
-import Maybe	    ( isJust )
-import Data.Char    ( chr )
+import Data.List
+import System.IO
+import Data.Maybe
 
 pprCmms :: [Cmm] -> SDoc
 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
@@ -81,6 +80,9 @@ instance Outputable CmmExpr where
 instance Outputable CmmReg where
     ppr e = pprReg e
 
+instance Outputable LocalReg where
+    ppr e = pprLocalReg e
+
 instance Outputable GlobalReg where
     ppr e = pprGlobalReg e
 
@@ -97,7 +99,7 @@ pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
 pprTop :: CmmTop -> SDoc
 pprTop (CmmProc info lbl params blocks )
 
-  = vcat [ pprCLabel lbl <> parens (commafy $ map pprLocalReg params) <+> lbrace
+  = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace
          , nest 8 $ pprInfo info lbl
          , nest 4 $ vcat (map ppr blocks)
          , rbrace ]
@@ -148,7 +150,7 @@ pprStmt stmt = case stmt of
 
     -- call "ccall" foo(x, y)[r1, r2];
     -- ToDo ppr volatile
-    CmmCall (CmmForeignCall fn cconv) results args _volatile ->
+    CmmCall (CmmForeignCall fn cconv) results args ->
         hcat [ ptext SLIT("call"), space, 
                doubleQuotes(ppr cconv), space,
                target fn, parens  ( commafy $ map ppr args ),
@@ -159,15 +161,16 @@ pprStmt stmt = case stmt of
             target (CmmLit lit) = pprLit lit
             target fn'          = parens (ppr fn')
 
-    CmmCall (CmmPrim op) results args volatile ->
+    CmmCall (CmmPrim op) results args ->
         pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv)
-                        results args volatile)
+                        results args)
         where
           lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
 
     CmmBranch ident          -> genBranch ident
     CmmCondBranch expr ident -> genCondBranch expr ident
     CmmJump expr params      -> genJump expr params
+    CmmReturn params         -> genReturn params
     CmmSwitch arg ids        -> genSwitch arg ids
 
 -- --------------------------------------------------------------------------
@@ -196,8 +199,8 @@ genCondBranch expr ident =
 --
 --     jump foo(a, b, c);
 --
-genJump :: CmmExpr -> [LocalReg] -> SDoc
-genJump expr actuals = 
+genJump :: CmmExpr -> [(CmmExpr, MachHint)] -> SDoc
+genJump expr args = 
 
     hcat [ ptext SLIT("jump")
          , space
@@ -206,12 +209,22 @@ genJump expr actuals =
                 else case expr of
                     CmmLoad (CmmReg _) _ -> pprExpr expr 
                     _ -> parens (pprExpr expr)
-         , pprActuals actuals
+         , space
+         , parens  ( commafy $ map ppr args )
          , semi ]
 
-  where
-    pprActuals [] = empty
-    pprActuals as = parens ( commafy $ map pprLocalReg as ) 
+-- --------------------------------------------------------------------------
+-- Return from a function. [1], Section 6.8.2 of version 1.128
+--
+--     return (a, b, c);
+--
+genReturn :: [(CmmExpr, MachHint)] -> SDoc
+genReturn args = 
+
+    hcat [ ptext SLIT("return")
+         , space
+         , parens  ( commafy $ map ppr args )
+         , semi ]
 
 -- --------------------------------------------------------------------------
 -- Tabled jump to local label
@@ -292,6 +305,8 @@ infixMachOp1 (MO_U_Lt   _) = Just (char '<')
 infixMachOp1 _             = Nothing
 
 -- %left '-' '+'
+pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
+   = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
    = pprExpr7 x <+> doc <+> pprExpr8 y
 pprExpr7 e = pprExpr8 e
@@ -337,7 +352,10 @@ genMachOp mop args
    || isJust (infixMachOp7 mop)
    || isJust (infixMachOp8 mop)	 = parens (pprExpr (CmmMachOp mop args))
 
-   | otherwise = char '%' <> pprMachOp mop <> parens (commafy (map pprExpr args))
+   | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
+        where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
+                                 (show mop))
+                -- replace spaces in (show mop) with underscores,
 
 --
 -- Unsigned ops on the word size of the machine get nice symbols.
@@ -392,8 +410,7 @@ pprStatic s = case s of
     CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
     CmmAlign i         -> nest 4 $ text "align" <+> int i
     CmmDataLabel clbl  -> pprCLabel clbl <> colon
-    CmmString s'       -> nest 4 $ text "I8[]" <+> 
-			   doubleQuotes (text (map (chr.fromIntegral) s'))
+    CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')
 
 -- --------------------------------------------------------------------------
 -- Registers, whether local (temps) or global