projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
fix Win32 build
[ghc-hetmet.git]
/
ghc
/
compiler
/
cmm
/
PprCmm.hs
diff --git
a/ghc/compiler/cmm/PprCmm.hs
b/ghc/compiler/cmm/PprCmm.hs
index
fb1dec1
..
6e8367d
100644
(file)
--- a/
ghc/compiler/cmm/PprCmm.hs
+++ b/
ghc/compiler/cmm/PprCmm.hs
@@
-51,6
+51,7
@@
import FastString ( mkFastString )
import Data.List ( intersperse, groupBy )
import IO ( Handle )
import Maybe ( isJust )
import Data.List ( intersperse, groupBy )
import IO ( Handle )
import Maybe ( isJust )
+import Data.Char ( chr )
pprCmms :: [Cmm] -> SDoc
pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
pprCmms :: [Cmm] -> SDoc
pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
@@
-134,7
+135,7
@@
pprStmt stmt = case stmt of
-- ;
CmmNop -> semi
-- ;
CmmNop -> semi
- -- // text
+ -- // text
CmmComment s -> text "//" <+> ftext s
-- reg = expr;
CmmComment s -> text "//" <+> ftext s
-- reg = expr;
@@
-219,18
+220,13
@@
genJump expr actuals =
--
-- switch [0 .. n] (expr) { case ... ; }
--
--
-- 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
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 .. ")
in hang (hcat [ ptext SLIT("switch [0 .. ")
- , int (length ids - 1)
+ , int (length maybe_ids - 1)
, ptext SLIT("] ")
, if isTrivialCmmExpr expr
then pprExpr expr
, ptext SLIT("] ")
, if isTrivialCmmExpr expr
then pprExpr expr
@@
-242,13
+238,16
@@
genSwitch expr maybe_ids
where
snds a b = (snd a) == (snd b)
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")
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
-- --------------------------------------------------------------------------
-- Expressions
@@
-317,8
+316,8
@@
pprExpr9 e =
CmmLit lit -> pprLit1 lit
CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
CmmReg reg -> ppr reg
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
CmmMachOp mop args -> genMachOp mop args
- e -> parens (pprExpr e)
genMachOp :: MachOp -> [CmmExpr] -> SDoc
genMachOp mop args
genMachOp :: MachOp -> [CmmExpr] -> SDoc
genMachOp mop args
@@
-352,7
+351,6
@@
infixMachOp mop
MO_Xor _ -> Just $ char '^'
MO_Not _ -> Just $ char '~'
MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
MO_Xor _ -> Just $ char '^'
MO_Not _ -> Just $ char '~'
MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
- MO_Not _ -> Just $ char '~'
_ -> Nothing
-- --------------------------------------------------------------------------
_ -> Nothing
-- --------------------------------------------------------------------------
@@
-371,6
+369,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
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
pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit)
pprLit1 lit = pprLit lit
@@
-392,7
+392,8
@@
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
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 s')
+ CmmString s' -> nest 4 $ text "I8[]" <+>
+ doubleQuotes (text (map (chr.fromIntegral) s'))
-- --------------------------------------------------------------------------
-- Registers, whether local (temps) or global
-- --------------------------------------------------------------------------
-- Registers, whether local (temps) or global
@@
-431,8
+432,7
@@
pprGlobalReg gr
GCEnter1 -> ptext SLIT("stg_gc_enter_1")
GCFun -> ptext SLIT("stg_gc_fun")
BaseReg -> ptext SLIT("BaseReg")
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
-- --------------------------------------------------------------------------
-- data sections
@@
-442,6
+442,8
@@
pprSection s = case s of
Text -> section <+> doubleQuotes (ptext SLIT("text"))
Data -> section <+> doubleQuotes (ptext SLIT("data"))
ReadOnlyData -> section <+> doubleQuotes (ptext SLIT("readonly"))
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
UninitialisedData -> section <+> doubleQuotes (ptext SLIT("uninitialised"))
OtherSection s' -> section <+> doubleQuotes (text s')
where