import Char ( ord, chr )
import IO ( Handle )
import DATA_BITS
+import Data.Word ( Word8 )
#ifdef DEBUG
import PprCmm () -- instances only
MO_F64_Log -> ptext SLIT("log")
MO_F64_Exp -> ptext SLIT("exp")
MO_F64_Sqrt -> ptext SLIT("sqrt")
- MO_F32_Pwr -> ptext SLIT("pow")
- MO_F32_Sin -> ptext SLIT("sin")
- MO_F32_Cos -> ptext SLIT("cos")
- MO_F32_Tan -> ptext SLIT("tan")
- MO_F32_Sinh -> ptext SLIT("sinh")
- MO_F32_Cosh -> ptext SLIT("cosh")
- MO_F32_Tanh -> ptext SLIT("tanh")
- MO_F32_Asin -> ptext SLIT("asin")
- MO_F32_Acos -> ptext SLIT("acos")
- MO_F32_Atan -> ptext SLIT("atan")
- MO_F32_Log -> ptext SLIT("log")
- MO_F32_Exp -> ptext SLIT("exp")
- MO_F32_Sqrt -> ptext SLIT("sqrt")
+ MO_F32_Pwr -> ptext SLIT("powf")
+ MO_F32_Sin -> ptext SLIT("sinf")
+ MO_F32_Cos -> ptext SLIT("cosf")
+ MO_F32_Tan -> ptext SLIT("tanf")
+ MO_F32_Sinh -> ptext SLIT("sinhf")
+ MO_F32_Cosh -> ptext SLIT("coshf")
+ MO_F32_Tanh -> ptext SLIT("tanhf")
+ MO_F32_Asin -> ptext SLIT("asinf")
+ MO_F32_Acos -> ptext SLIT("acosf")
+ MO_F32_Atan -> ptext SLIT("atanf")
+ MO_F32_Log -> ptext SLIT("logf")
+ MO_F32_Exp -> ptext SLIT("expf")
+ MO_F32_Sqrt -> ptext SLIT("sqrtf")
-- ---------------------------------------------------------------------
-- Useful #defines
pprCall ppr_fn cconv results args vols
| not (is_cish cconv)
- = panic "pprForeignCall: unknown calling convention"
+ = panic "pprCall: unknown calling convention"
| otherwise
= save vols $$
ptext SLIT("CALLER_SAVE_SYSTEM") $$
- hcat [ ppr_results results, ppr_fn,
- parens (commafy (map pprArg args)), semi ] $$
+ ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi $$
ptext SLIT("CALLER_RESTORE_SYSTEM") $$
restore vols
where
- ppr_results [] = empty
- ppr_results [(one,hint)]
+ ppr_assign [] rhs = rhs
+ ppr_assign [(reg@(CmmGlobal BaseReg), hint)] rhs
+ | Just ty <- strangeRegType reg
+ = ptext SLIT("ASSIGN_BaseReg") <> parens (parens ty <> rhs)
+ -- BaseReg is special, sometimes it isn't an lvalue and we
+ -- can't assign to it.
+ ppr_assign [(one,hint)] rhs
| Just ty <- strangeRegType one
- = pprReg one <> ptext SLIT(" = ") <> parens ty
+ = pprReg one <> ptext SLIT(" = ") <> parens ty <> rhs
| otherwise
= pprReg one <> ptext SLIT(" = ")
- <> pprUnHint hint (cmmRegRep one)
- ppr_results _other = panic "pprCall: multiple results"
+ <> pprUnHint hint (cmmRegRep one) <> rhs
+ ppr_assign _other _rhs = panic "pprCall: multiple results"
pprArg (expr, PtrHint)
= cCast (ptext SLIT("void *")) expr
-- ---------------------------------------------------------------------
-- 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