[project @ 2005-05-21 15:39:00 by panne]

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

diff --git a/ghc/compiler/cmm/PprCmm.hs b/ghc/compiler/cmm/PprCmm.hs
index fb1dec1..3c3e976 100644 (file)
--- a/ghc/compiler/cmm/PprCmm.hs
+++ b/ghc/compiler/cmm/PprCmm.hs
@@ -134,7 +134,7 @@ pprStmt stmt = case stmt of
     -- ;
     CmmNop -> semi
 
-    -- // text
+    --  // text
     CmmComment s -> text "//" <+> ftext s
 
     -- reg = expr;
@@ -219,18 +219,13 @@ genJump expr actuals =
 --
 --      switch [0 .. n] (expr) { case ... ; }
 --
--- N.B. we remove 'Nothing's from the list of branches, as they don't
--- seem to make sense currently. This may change, if they are defined in
--- some way.
---
 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
 genSwitch expr maybe_ids 
 
-    = let ids   = [ i | Just i <- maybe_ids ]
-          pairs = groupBy snds (zip [0 .. ] ids )
+    = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
 
       in hang (hcat [ ptext SLIT("switch [0 .. ") 
-                    , int (length ids - 1)
+                    , int (length maybe_ids - 1)
                     , ptext SLIT("] ")
                     , if isTrivialCmmExpr expr
                         then pprExpr expr
@@ -242,13 +237,16 @@ genSwitch expr maybe_ids
     where
       snds a b = (snd a) == (snd b)
 
-      caseify :: [(Int,BlockId)] -> SDoc
+      caseify :: [(Int,Maybe BlockId)] -> SDoc
+      caseify ixs@((i,Nothing):_)
+        = ptext SLIT("/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
+               <> ptext SLIT(" */")
       caseify as 
         = let (is,ids) = unzip as 
           in hsep [ ptext SLIT("case")
                   , hcat (punctuate comma (map int is))
                   , ptext SLIT(": goto")
-                  , pprBlockId (head ids) <> semi ]
+                  , pprBlockId (head [ id | Just id <- ids]) <> semi ]
 
 -- --------------------------------------------------------------------------
 -- Expressions
@@ -317,8 +315,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)
        CmmMachOp mop args  -> genMachOp mop args
-       e                   -> parens (pprExpr e)
 
 genMachOp :: MachOp -> [CmmExpr] -> SDoc
 genMachOp mop args
@@ -352,7 +350,6 @@ infixMachOp mop
             MO_Xor    _ -> Just $ char '^'
             MO_Not    _ -> Just $ char '~'
             MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)
-           MO_Not    _ -> Just $ char '~'
             _ -> Nothing
 
 -- --------------------------------------------------------------------------
@@ -371,6 +368,8 @@ pprLit lit = case lit of
     CmmFloat f rep     -> hsep [ rational f, dcolon, ppr rep ]
     CmmLabel clbl      -> pprCLabel clbl
     CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
+    CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'  
+                                  <> pprCLabel clbl2 <> ppr_offset i
 
 pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit)
 pprLit1 lit                      = pprLit lit
@@ -431,8 +430,7 @@ pprGlobalReg gr
         GCEnter1       -> ptext SLIT("stg_gc_enter_1")
         GCFun          -> ptext SLIT("stg_gc_fun")
         BaseReg        -> ptext SLIT("BaseReg")
-
-        _ -> panic $ "PprCmm.pprGlobalReg: unknown global reg"
+        PicBaseReg     -> ptext SLIT("PicBaseReg")
 
 -- --------------------------------------------------------------------------
 -- data sections
@@ -442,6 +440,8 @@ pprSection s = case s of
     Text              -> section <+> doubleQuotes (ptext SLIT("text"))
     Data              -> section <+> doubleQuotes (ptext SLIT("data"))
     ReadOnlyData      -> section <+> doubleQuotes (ptext SLIT("readonly"))
+    RelocatableReadOnlyData
+                      -> section <+> doubleQuotes (ptext SLIT("relreadonly"))
     UninitialisedData -> section <+> doubleQuotes (ptext SLIT("uninitialised"))
     OtherSection s'   -> section <+> doubleQuotes (text s')
  where