projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2006-01-06 16:30:17 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
8bcfd0c
..
9fece36
100644
(file)
--- a/
ghc/compiler/cmm/PprC.hs
+++ b/
ghc/compiler/cmm/PprC.hs
@@
-45,6
+45,7
@@
import Data.Bits ( shiftR )
import Char ( ord, chr )
import IO ( Handle )
import DATA_BITS
import Char ( ord, chr )
import IO ( Handle )
import DATA_BITS
+import Data.Word ( Word8 )
#ifdef DEBUG
import PprCmm () -- instances only
#ifdef DEBUG
import PprCmm () -- instances only
@@
-654,6
+655,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 :: 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.
strangeRegType _ = Nothing
-- pprReg just prints the register name.
@@
-707,6
+709,9
@@
pprCall ppr_fn cconv results args vols
where
ppr_results [] = empty
ppr_results [(one,hint)]
where
ppr_results [] = empty
ppr_results [(one,hint)]
+ | 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"
= pprReg one <> ptext SLIT(" = ")
<> pprUnHint hint (cmmRegRep one)
ppr_results _other = panic "pprCall: multiple results"
@@
-877,25
+882,21
@@
machRepSignedCType r | r == wordRep = ptext SLIT("I_")
-- ---------------------------------------------------------------------
-- print strings as valid C strings
-- ---------------------------------------------------------------------
-- print strings as valid C strings
--- Assumes it contains only characters '\0'..'\xFF'!
-pprFSInCStyle :: FastString -> SDoc
-pprFSInCStyle fs = pprStringInCStyle (unpackFS fs)
-
-pprStringInCStyle :: String -> SDoc
+pprStringInCStyle :: [Word8] -> SDoc
pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
-charToC :: Char -> String
-charToC '\"' = "\\\""
-charToC '\'' = "\\\'"
-charToC '\\' = "\\\\"
-charToC c | c >= ' ' && c <= '~' = [c]
- | c > '\xFF' = panic ("charToC "++show c)
- | otherwise = ['\\',
+charToC :: Word8 -> String
+charToC w =
+ case chr (fromIntegral w) of
+ '\"' -> "\\\""
+ '\'' -> "\\\'"
+ '\\' -> "\\\\"
+ c | c >= ' ' && c <= '~' -> [c]
+ | otherwise -> ['\\',
chr (ord '0' + ord c `div` 64),
chr (ord '0' + ord c `div` 8 `mod` 8),
chr (ord '0' + ord c `mod` 8)]
chr (ord '0' + ord c `div` 64),
chr (ord '0' + ord c `div` 8 `mod` 8),
chr (ord '0' + ord c `mod` 8)]
-
-- ---------------------------------------------------------------------------
-- Initialising static objects with floating-point numbers. We can't
-- just emit the floating point number, because C will cast it to an int
-- ---------------------------------------------------------------------------
-- Initialising static objects with floating-point numbers. We can't
-- just emit the floating point number, because C will cast it to an int