X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fcmm%2FPprC.hs;h=c7d0cf16c11977b784ee44eb5cdd908f9efc1ced;hb=e5d9aaa2b7b717c862651f8eea5e2dc66f0a8028;hp=7127be351ce0df389d25696f9affec26516ea9db;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 7127be3..c7d0cf1 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -1,3 +1,10 @@ +{-# 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 @@ -16,13 +23,6 @@ -- ToDo: save/restore volatile registers around calls. -{-# OPTIONS_GHC -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/WorkingConventions#Warnings --- for details - module PprC ( writeCs, pprStringInCStyle @@ -98,7 +98,7 @@ pprC (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops -- 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 @@ -145,7 +145,6 @@ pprTop top@(CmmData _section (CmmDataLabel lbl : lits)) = -- 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. -- @@ -237,7 +236,7 @@ pprStmt stmt = case stmt of 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, @@ -426,7 +425,13 @@ pprLit1 other = pprLit other 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) @@ -727,7 +732,7 @@ pprLocalReg (LocalReg uniq _ _) = char '_' <> ppr uniq -- ----------------------------------------------------------------------------- -- Foreign Calls -pprCall :: SDoc -> CCallConv -> CmmHintFormals -> CmmActuals -> CmmSafety +pprCall :: SDoc -> CCallConv -> CmmFormals -> CmmActuals -> CmmSafety -> SDoc pprCall ppr_fn cconv results args _