import ForeignCall
-- Utils
+import DynFlags ( DynFlags, DynFlag(..), dopt )
import Unique ( getUnique )
import UniqSet
import FiniteMap
import FastString
import Outputable
import Constants
-import CmdLineOpts ( opt_EnsureSplittableC )
-- The rest
import Data.List ( intersperse, groupBy )
-- --------------------------------------------------------------------------
-- Top level
-pprCs :: [Cmm] -> SDoc
-pprCs cmms = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
-
-writeCs :: Handle -> [Cmm] -> IO ()
-writeCs handle cmms = printForUser handle alwaysQualify (pprCs cmms)
- -- ToDo: should be printForC
+pprCs :: DynFlags -> [Cmm] -> SDoc
+pprCs dflags cmms
+ = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
+ where
+ split_marker
+ | dopt Opt_SplitObjs dflags = ptext SLIT("__STG_SPLIT_MARKER")
+ | otherwise = empty
-split_marker
- | opt_EnsureSplittableC = ptext SLIT("__STG_SPLIT_MARKER")
- | otherwise = empty
+writeCs :: DynFlags -> Handle -> [Cmm] -> IO ()
+writeCs dflags handle cmms
+ = printForUser handle alwaysQualify (pprCs dflags cmms)
+ -- ToDo: should be printForC
-- --------------------------------------------------------------------------
-- Now do some real work
CmmAssign dest src -> pprAssign dest src
CmmStore dest src
- | rep == I64
+ | rep == I64 && wordRep /= I64
-> ptext SLIT("ASSIGN_Word64") <>
parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
+ | rep == F64 && wordRep /= I64
+ -> ptext SLIT("ASSIGN_DBL") <>
+ parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
+
| otherwise
-> hsep [ pprExpr (CmmLoad dest rep), equals, pprExpr src <> semi ]
where
caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
where
do_fallthrough ix =
- hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
+ hsep [ ptext SLIT("case") , pprHexVal ix wordRep <> colon ,
ptext SLIT("/* fall through */") ]
final_branch ix =
- hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
+ hsep [ ptext SLIT("case") , pprHexVal ix wordRep <> colon ,
ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-- ---------------------------------------------------------------------
pprExpr e = case e of
CmmLit lit -> pprLit lit
- CmmLoad e I64
+ CmmLoad e I64 | wordRep /= I64
-> ptext SLIT("PK_Word64") <> parens (mkP_ <> pprExpr1 e)
+ CmmLoad e F64 | wordRep /= I64
+ -> ptext SLIT("PK_DBL") <> parens (mkP_ <> pprExpr1 e)
+
CmmLoad (CmmReg r) rep
| isPtrReg r && rep == wordRep
-> char '*' <> pprAsPtrReg r
pprLit :: CmmLit -> SDoc
pprLit lit = case lit of
- CmmInt i I64 | machRepByteWidth I32 == wORD_SIZE
- -> pprHexVal i <> ptext SLIT("LL")
- -- Append an 'LL' suffix to 64-bit integers on a 32-bit
- -- platform. This might not be strictly necessary (the
- -- type will always be apparent from the context), but
- -- it avoids some warnings from gcc.
- CmmInt i _rep -> pprHexVal i
+ CmmInt i rep -> pprHexVal i rep
CmmFloat f rep -> parens (machRepCType rep) <> (rational f)
- CmmLabel clbl -> mkW_ <> pprCLabel clbl
- CmmLabelOff clbl i -> mkW_ <> pprCLabel clbl <> char '+' <> int i
+ CmmLabel clbl -> mkW_ <> pprCLabelAddr clbl
+ CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i
CmmLabelDiffOff clbl1 clbl2 i
-- WARNING:
- -- * the lit must occur in the info table clbl2
- -- * clbl1 must be an SRT, a slow entry point or a large bitmap
+ -- * the lit must occur in the info table clbl2
+ -- * clbl1 must be an SRT, a slow entry point or a large bitmap
-- The Mangler is expected to convert any reference to an SRT,
-- a slow entry point or a large bitmap
-- from an info table to an offset.
- -> mkW_ <> pprCLabel clbl1 <> char '+' <> int i
+ -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i
+
+pprCLabelAddr lbl = char '&' <> pprCLabel lbl
pprLit1 :: CmmLit -> SDoc
pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
MO_F64_Cosh -> ptext SLIT("cosh")
MO_F64_Tanh -> ptext SLIT("tanh")
MO_F64_Asin -> ptext SLIT("asin")
- MO_F64_Acos -> ptext SLIT("asin")
+ MO_F64_Acos -> ptext SLIT("acos")
MO_F64_Atan -> ptext SLIT("atan")
MO_F64_Log -> ptext SLIT("log")
MO_F64_Exp -> ptext SLIT("exp")
isStrangeTypeGlobal :: GlobalReg -> Bool
isStrangeTypeGlobal CurrentTSO = True
isStrangeTypeGlobal CurrentNursery = True
+isStrangeTypeGlobal BaseReg = True
isStrangeTypeGlobal r = isPtrGlobalReg r
strangeRegType :: CmmReg -> Maybe SDoc
where
ppr_results [] = empty
ppr_results [(one,hint)]
- = pprExpr (CmmReg one) <> ptext SLIT(" = ")
+ = 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
commafy xs = hsep $ punctuate comma xs
-- Print in C hex format: 0x13fa
-pprHexVal :: Integer -> SDoc
-pprHexVal 0 = ptext SLIT("0x0")
-pprHexVal w
- | w < 0 = parens (char '-' <> ptext SLIT("0x") <> go (-w))
- | otherwise = ptext SLIT("0x") <> go w
+pprHexVal :: Integer -> MachRep -> SDoc
+pprHexVal 0 _ = ptext SLIT("0x0")
+pprHexVal w rep
+ | w < 0 = parens (char '-' <> ptext SLIT("0x") <> go (-w) <> repsuffix rep)
+ | 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")
+ -- on 64-bit platforms with 32-bit int, add "L" to 64-bit literals
+ repsuffix I64 | cINT_SIZE == 4 = ptext SLIT("L")
+ repsuffix _ = empty
+
go 0 = empty
go w' = go q <> dig
where
projects / ghc-hetmet.git / blobdiff