+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Pretty-printing of Cmm as C, suitable for feeding gcc
-- top level procs
--
pprTop :: RawCmmTop -> SDoc
-pprTop (CmmProc info clbl _params blocks) =
+pprTop (CmmProc info clbl _params (ListGraph blocks)) =
(if not (null info)
then pprDataExterns info $$
pprWordArray (entryLblToInfoLbl clbl) info
-- these shouldn't appear?
pprTop (CmmData _ _) = panic "PprC.pprTop: can't handle this data"
-
-- --------------------------------------------------------------------------
-- BasicBlocks are self-contained entities: they always end in a jump.
--
where
rep = cmmExprRep src
- CmmCall (CmmForeignCall fn cconv) results args safety ->
+ CmmCall (CmmCallee fn cconv) results args safety _ret ->
-- Controversial: leave this out for now.
-- pprUndef fn $$
ptext SLIT("#undef") <+> pprCLabel lbl
pprUndef _ = empty
- CmmCall (CmmPrim op) results args safety ->
+ CmmCall (CmmPrim op) results args safety _ret ->
pprCall ppr_fn CCallConv results args safety
where
ppr_fn = pprCallishMachOp_for_C op
CmmJump lbl _params -> mkJMP_(pprExpr lbl) <> semi
CmmSwitch arg ids -> pprSwitch arg ids
-pprCFunType :: CCallConv -> CmmHintFormals -> CmmActuals -> SDoc
+pprCFunType :: CCallConv -> CmmFormals -> CmmActuals -> SDoc
pprCFunType cconv ress args
= hcat [
res_type ress,
]
where
res_type [] = ptext SLIT("void")
- res_type [(one,hint)] = machRepHintCType (localRegRep one) hint
+ res_type [CmmHinted one hint] = machRepHintCType (localRegRep one) hint
- arg_type (expr,hint) = machRepHintCType (cmmExprRep expr) hint
+ arg_type (CmmHinted expr hint) = machRepHintCType (cmmExprRep expr) hint
-- ---------------------------------------------------------------------
-- unconditional branches
-> char '*' <> pprAsPtrReg r
CmmLoad (CmmRegOff r off) rep
- | isPtrReg r && rep == wordRep
+ | isPtrReg r && rep == wordRep && (off `rem` wORD_SIZE == 0)
-- ToDo: check that the offset is a word multiple?
+ -- (For tagging to work, I had to avoid unaligned loads. --ARY)
-> pprAsPtrReg r <> brackets (ppr (off `shiftR` wordShift))
CmmLoad expr rep ->
pprStatics :: [CmmStatic] -> [SDoc]
pprStatics [] = []
pprStatics (CmmStaticLit (CmmFloat f F32) : rest)
+ -- floats are padded to a word, see #1852
+ | wORD_SIZE == 8, CmmStaticLit (CmmInt 0 I32) : rest' <- rest
+ = pprLit1 (floatToWord f) : pprStatics rest'
+ | wORD_SIZE == 4
= pprLit1 (floatToWord f) : pprStatics rest
+ | otherwise
+ = pprPanic "pprStatics: float" (vcat (map (\(CmmStaticLit l) -> ppr (cmmLitRep l)) rest))
pprStatics (CmmStaticLit (CmmFloat f F64) : rest)
= map pprLit1 (doubleToWords f) ++ pprStatics rest
pprStatics (CmmStaticLit (CmmInt i I64) : rest)
-- -----------------------------------------------------------------------------
-- Foreign Calls
-pprCall :: SDoc -> CCallConv -> CmmHintFormals -> CmmActuals -> CmmSafety
+pprCall :: SDoc -> CCallConv -> CmmFormals -> CmmActuals -> CmmSafety
-> SDoc
pprCall ppr_fn cconv results args _
ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi
where
ppr_assign [] rhs = rhs
- ppr_assign [(one,hint)] rhs
+ ppr_assign [CmmHinted one hint] rhs
= pprLocalReg one <> ptext SLIT(" = ")
<> pprUnHint hint (localRegRep one) <> rhs
ppr_assign _other _rhs = panic "pprCall: multiple results"
- pprArg (expr, PtrHint)
+ pprArg (CmmHinted expr PtrHint)
= cCast (ptext SLIT("void *")) expr
-- see comment by machRepHintCType below
- pprArg (expr, SignedHint)
+ pprArg (CmmHinted expr SignedHint)
= cCast (machRepSignedCType (cmmExprRep expr)) expr
- pprArg (expr, _other)
+ pprArg (CmmHinted expr _other)
= pprExpr expr
pprUnHint PtrHint rep = parens (machRepCType rep)
--
pprTempAndExternDecls :: [CmmBasicBlock] -> (SDoc{-temps-}, SDoc{-externs-})
pprTempAndExternDecls stmts
- = (vcat (map pprTempDecl (eltsUFM temps)),
+ = (vcat (map pprTempDecl (uniqSetToList temps)),
vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls)))
where (temps, lbls) = runTE (mapM_ te_BB stmts)
| not (needsCDecl lbl) = empty
| otherwise =
hcat [ visibility, label_type (labelType lbl),
- lparen, dyn_wrapper (pprCLabel lbl), text ");" ]
+ lparen, pprCLabel lbl, text ");" ]
where
- dyn_wrapper d
- | in_srt && labelDynamic lbl = text "DLL_IMPORT_DATA_VAR" <> parens d
- | otherwise = d
-
label_type CodeLabel = ptext SLIT("F_")
label_type DataLabel = ptext SLIT("I_")
te_Stmt :: CmmStmt -> TE ()
te_Stmt (CmmAssign r e) = te_Reg r >> te_Expr e
te_Stmt (CmmStore l r) = te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es _) = mapM_ (te_temp.fst) rs >>
- mapM_ (te_Expr.fst) es
+te_Stmt (CmmCall _ rs es _ _) = mapM_ (te_temp.hintlessCmm) rs >>
+ mapM_ (te_Expr.hintlessCmm) es
te_Stmt (CmmCondBranch e _) = te_Expr e
te_Stmt (CmmSwitch e _) = te_Expr e
te_Stmt (CmmJump e _) = te_Expr e