Replacing copyins and copyouts with data-movement instructions

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

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 24b1287..dbfd20e 100644 (file)
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -37,8 +37,8 @@ module PprCmm
     )
 where
 
+import BlockId
 import Cmm
-import CmmExpr
 import CmmUtils
 import MachOp
 import CLabel
@@ -91,6 +91,9 @@ instance Outputable CmmLit where
 instance Outputable LocalReg where
     ppr e = pprLocalReg e
 
+instance Outputable Area where
+    ppr e = pprArea e
+
 instance Outputable GlobalReg where
     ppr e = pprGlobalReg e
 
@@ -246,9 +249,9 @@ pprStmt stmt = case stmt of
                  | otherwise    = commafy (map ppr_ar results) <+> equals
                -- Don't print the hints on a native C-- call
          ppr_ar arg = case cconv of
-                           CmmCallConv -> ppr (hintlessCmm arg)
-                           _           -> doubleQuotes (ppr $ cmmHint arg) <+>
-                                           ppr (hintlessCmm arg)
+                           CmmCallConv -> ppr (kindlessCmm arg)
+                           _           -> doubleQuotes (ppr $ cmmKind arg) <+>
+                                           ppr (kindlessCmm arg)
          _pp_conv = case cconv of
                      CmmCallConv -> empty
                      _ -> ptext (sLit "foreign") <+> doubleQuotes (ppr cconv)
@@ -294,7 +297,7 @@ genCondBranch expr ident =
 --
 --     jump foo(a, b, c);
 --
-genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
+genJump :: CmmExpr -> [CmmKinded CmmExpr] -> SDoc
 genJump expr args = 
 
     hcat [ ptext (sLit "jump")
@@ -305,21 +308,21 @@ genJump expr args =
                     CmmLoad (CmmReg _) _ -> pprExpr expr 
                     _ -> parens (pprExpr expr)
          , space
-         , parens  ( commafy $ map pprHinted args )
+         , parens  ( commafy $ map pprKinded args )
          , semi ]
 
-pprHinted :: Outputable a => (CmmHinted a) -> SDoc
-pprHinted (CmmHinted a NoHint)     = ppr a
-pprHinted (CmmHinted a PtrHint)    = quotes(text "address") <+> ppr a
-pprHinted (CmmHinted a SignedHint) = quotes(text "signed")  <+> ppr a
-pprHinted (CmmHinted a FloatHint)  = quotes(text "float")   <+> ppr a
+pprKinded :: Outputable a => (CmmKinded a) -> SDoc
+pprKinded (CmmKinded a NoHint)     = ppr a
+pprKinded (CmmKinded a PtrHint)    = quotes(text "address") <+> ppr a
+pprKinded (CmmKinded a SignedHint) = quotes(text "signed")  <+> ppr a
+pprKinded (CmmKinded a FloatHint)  = quotes(text "float")   <+> ppr a
 
 -- --------------------------------------------------------------------------
 -- Return from a function. [1], Section 6.8.2 of version 1.128
 --
 --     return (a, b, c);
 --
-genReturn :: [CmmHinted CmmExpr] -> SDoc
+genReturn :: [CmmKinded CmmExpr] -> SDoc
 genReturn args = 
 
     hcat [ ptext (sLit "return")
@@ -435,7 +438,8 @@ pprExpr9 e =
         CmmLit    lit       -> pprLit1 lit
         CmmLoad   expr rep  -> ppr rep <> brackets( ppr expr )
         CmmReg    reg       -> ppr reg
-        CmmRegOff reg off   -> parens (ppr reg <+> char '+' <+> int off)
+        CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)
+        CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)
        CmmMachOp mop args  -> genMachOp mop args
 
 genMachOp :: MachOp -> [CmmExpr] -> SDoc
@@ -523,7 +527,7 @@ pprStatic s = case s of
 pprReg :: CmmReg -> SDoc
 pprReg r 
     = case r of
-        CmmLocal  local  -> pprLocalReg local
+        CmmLocal  local  -> pprLocalReg  local
         CmmGlobal global -> pprGlobalReg global
 
 --
@@ -539,6 +543,12 @@ pprLocalReg (LocalReg uniq rep follow)
                 then empty
                 else doubleQuotes (text "ptr")
 
+-- Stack areas
+pprArea :: Area -> SDoc
+pprArea (RegSlot r)    = hcat [ text "slot<", ppr r, text ">" ]
+pprArea (CallArea id n n') =
+  hcat [ text "callslot<", ppr id, char '+', ppr n, char '/', ppr n', text ">" ]
+
 -- needs to be kept in syn with Cmm.hs.GlobalReg
 --
 pprGlobalReg :: GlobalReg -> SDoc