import CmdLineOpts ( opt_EnsureSplittableC )
-- The rest
-import Data.List ( intersperse, group )
+import Data.List ( intersperse, groupBy )
import Data.Bits ( shiftR )
import Char ( ord, chr )
import IO ( Handle )
pprTop :: CmmTop -> SDoc
pprTop (CmmProc info clbl _params blocks) =
(if not (null info)
- then pprWordArray (entryLblToInfoLbl clbl) info
+ then pprDataExterns info $$
+ pprWordArray (entryLblToInfoLbl clbl) info
else empty) $$
(case blocks of
[] -> empty
where
ppr_fn = case fn of
CmmLit (CmmLabel lbl) -> pprCLabel lbl
- _other -> parens (cCast (pprCFunType results args) fn)
+ _other -> parens (cCast (pprCFunType cconv results args) fn)
-- for a dynamic call, cast the expression to
-- a function of the right type (we hope).
CmmJump lbl _params -> mkJMP_(pprExpr lbl) <> semi
CmmSwitch arg ids -> pprSwitch arg ids
-pprCFunType :: [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)] -> SDoc
-pprCFunType ress args =
- res_type ress <> parens (char '*') <> parens (commafy (map arg_type args))
+pprCFunType :: CCallConv -> [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)] -> SDoc
+pprCFunType cconv ress args
+ = hcat [
+ res_type ress,
+ parens (text (ccallConvAttribute cconv) <> char '*'),
+ parens (commafy (map arg_type args))
+ ]
where
res_type [] = ptext SLIT("void")
res_type [(one,hint)] = machRepHintCType (cmmRegRep one) hint
--
pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
pprSwitch e maybe_ids
- = let ids = [ i | Just i <- maybe_ids ]
- pairs = zip [ 0 .. ] (concatMap markfalls (group ids))
+ = let pairs = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
+ pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
in
(hang (ptext SLIT("switch") <+> parens ( pprExpr e ) <+> lbrace)
- 4 (vcat ( map caseify pairs )))
+ 4 (vcat ( map caseify pairs2 )))
$$ rbrace
where
- -- fall through case
- caseify (i,Left ident) =
- hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
- ptext SLIT("/* fall through for"),
- pprBlockId ident,
- ptext SLIT("*/") ]
-
- caseify (i,Right ident) =
- hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
- ptext SLIT("goto") , (pprBlockId ident) <> semi ]
+ sndEq (_,x) (_,y) = x == y
- -- mark the bottom of a fallthough sequence of cases as `Right'
- markfalls [a] = [Right a]
- markfalls as = map (\a -> Left a) (init as) ++ [Right (last as)]
+ -- fall through case
+ caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
+ where
+ do_fallthrough ix =
+ hsep [ ptext SLIT("case") , pprHexVal ix wordRep <> colon ,
+ ptext SLIT("/* fall through */") ]
+ final_branch ix =
+ hsep [ ptext SLIT("case") , pprHexVal ix wordRep <> colon ,
+ ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-- ---------------------------------------------------------------------
-- Expressions.
pprLit :: CmmLit -> SDoc
pprLit lit = case lit of
- 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
+ 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 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
pprLit1 :: CmmLit -> SDoc
pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
+pprLit1 lit@(CmmLabelDiffOff _ _ _) = parens (pprLit lit)
pprLit1 lit@(CmmFloat _ _) = parens (pprLit lit)
pprLit1 other = pprLit other
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")
where
ppr_results [] = empty
ppr_results [(one,hint)]
- = pprExpr (CmmReg one) <> ptext SLIT(" = ") <> pprUnHint hint
+ = pprExpr (CmmReg one) <> ptext SLIT(" = ")
+ <> pprUnHint hint (cmmRegRep one)
ppr_results _other = panic "pprCall: multiple results"
pprArg (expr, PtrHint)
pprArg (expr, _other)
= pprExpr expr
- pprUnHint PtrHint = mkW_
- pprUnHint SignedHint = mkW_
- pprUnHint _ = empty
-
+ pprUnHint PtrHint rep = parens (machRepCType rep)
+ pprUnHint SignedHint rep = parens (machRepCType rep)
+ pprUnHint _ _ = empty
+
save = save_restore SLIT("CALLER_SAVE")
restore = save_restore SLIT("CALLER_RESTORE")
te_Lit :: CmmLit -> TE ()
te_Lit (CmmLabel l) = te_lbl l
+te_Lit (CmmLabelOff l _) = te_lbl l
+te_Lit (CmmLabelDiffOff l1 l2 _) = te_lbl l1
te_Lit _ = return ()
te_Stmt :: CmmStmt -> TE ()
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