import Char ( ord, chr )
import IO ( Handle )
import DATA_BITS
+import Data.Word ( Word8 )
#ifdef DEBUG
import PprCmm () -- instances only
writeCs :: DynFlags -> Handle -> [Cmm] -> IO ()
writeCs dflags handle cmms
- = printForUser handle alwaysQualify (pprCs dflags cmms)
- -- ToDo: should be printForC
+ = printForC handle (pprCs dflags cmms)
-- --------------------------------------------------------------------------
-- Now do some real work
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.
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"
VanillaReg n -> char 'R' <> int n -- without the .w suffix
_ -> pprGlobalReg gr
+-- Currently we only have these two calling conventions, but this might
+-- change in the future...
is_cish CCallConv = True
is_cish StdCallConv = True
-is_cish _ = False
-- ---------------------------------------------------------------------
-- Find and print local and external declarations for a list of
te_Expr :: CmmExpr -> TE ()
te_Expr (CmmLit lit) = te_Lit lit
-te_Expr (CmmReg r) = te_Reg r
te_Expr (CmmLoad e _) = te_Expr e
+te_Expr (CmmReg r) = te_Reg r
te_Expr (CmmMachOp _ es) = mapM_ te_Expr es
te_Expr (CmmRegOff r _) = te_Reg r
-te_Expr _ = return ()
te_Reg :: CmmReg -> TE ()
te_Reg (CmmLocal l) = te_temp l
-- ---------------------------------------------------------------------
-- 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))
-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)]
-
-- ---------------------------------------------------------------------------
-- Initialising static objects with floating-point numbers. We can't
-- just emit the floating point number, because C will cast it to an int
| otherwise = ptext SLIT("0x") <> go w <> repsuffix rep
where
-- type suffix for literals:
- -- on 32-bit platforms, add "LL" to 64-bit literals
- repsuffix I64 | wORD_SIZE == 4 = ptext SLIT("LL")
+ -- Integer literals are unsigned in Cmm/C. We explicitly cast to
+ -- signed values for doing signed operations, but at all other
+ -- times values are unsigned. This also helps eliminate occasional
+ -- warnings about integer overflow from gcc.
+
+ -- on 32-bit platforms, add "ULL" to 64-bit literals
+ repsuffix I64 | wORD_SIZE == 4 = ptext SLIT("ULL")
-- on 64-bit platforms with 32-bit int, add "L" to 64-bit literals
- repsuffix I64 | cINT_SIZE == 4 = ptext SLIT("L")
- repsuffix _ = empty
+ repsuffix I64 | cINT_SIZE == 4 = ptext SLIT("UL")
+ repsuffix _ = char 'U'
go 0 = empty
go w' = go q <> dig