X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FPprC.hs;h=1e11c0c55ba145eafda80ea8735e7c8cc52d9945;hb=fa328fb3cbf09e767a35ecc2dd9811d6673882da;hp=10c9f183103dda1c671eeb66930a4872a64a435e;hpb=889c084e943779e76d19f2ef5e970ff655f511eb;p=ghc-hetmet.git diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 10c9f18..1e11c0c 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -50,6 +50,7 @@ import Outputable import Constants import BasicTypes import CLabel +import Util -- The rest import Data.List @@ -63,10 +64,6 @@ import Data.Word import Data.Array.ST import Control.Monad.ST -#if x86_64_TARGET_ARCH -import StaticFlags ( opt_Unregisterised ) -#endif - #if defined(alpha_TARGET_ARCH) || defined(mips_TARGET_ARCH) || defined(mipsel_TARGET_ARCH) || defined(arm_TARGET_ARCH) #define BEWARE_LOAD_STORE_ALIGNMENT #endif @@ -104,18 +101,19 @@ pprTop (CmmProc info clbl (ListGraph blocks)) = then pprDataExterns info $$ pprWordArray (entryLblToInfoLbl clbl) info else empty) $$ - (case blocks of - [] -> empty - -- the first block doesn't get a label: - (BasicBlock _ stmts : rest) -> vcat [ + (vcat [ blankLine, extern_decls, (if (externallyVisibleCLabel clbl) then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace, nest 8 temp_decls, nest 8 mkFB_, - nest 8 (vcat (map pprStmt stmts)) $$ - vcat (map pprBBlock rest), + case blocks of + [] -> empty + -- the first block doesn't get a label: + (BasicBlock _ stmts : rest) -> + nest 8 (vcat (map pprStmt stmts)) $$ + vcat (map pprBBlock rest), nest 8 mkFE_, rbrace ] ) @@ -268,7 +266,7 @@ pprStmt stmt = case stmt of CmmJump lbl _params -> mkJMP_(pprExpr lbl) <> semi CmmSwitch arg ids -> pprSwitch arg ids -pprCFunType :: SDoc -> CCallConv -> HintedCmmFormals -> HintedCmmActuals -> SDoc +pprCFunType :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> SDoc pprCFunType ppr_fn cconv ress args = res_type ress <+> parens (text (ccallConvAttribute cconv) <> ppr_fn) <> @@ -809,7 +807,7 @@ pprLocalReg (LocalReg uniq _) = char '_' <> ppr uniq -- ----------------------------------------------------------------------------- -- Foreign Calls -pprCall :: SDoc -> CCallConv -> HintedCmmFormals -> HintedCmmActuals -> CmmSafety +pprCall :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> CmmSafety -> SDoc pprCall ppr_fn cconv results args _ @@ -818,17 +816,6 @@ pprCall ppr_fn cconv results args _ | otherwise = -#if x86_64_TARGET_ARCH - -- HACK around gcc optimisations. - -- x86_64 needs a __DISCARD__() here, to create a barrier between - -- putting the arguments into temporaries and passing the arguments - -- to the callee, because the argument expressions may refer to - -- machine registers that are also used for passing arguments in the - -- C calling convention. - (if (not opt_Unregisterised) - then ptext (sLit "__DISCARD__();") - else empty) $$ -#endif ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi where ppr_assign [] rhs = rhs @@ -1022,18 +1009,6 @@ machRep_S_CType _ = panic "machRep_S_CType" pprStringInCStyle :: [Word8] -> SDoc pprStringInCStyle s = doubleQuotes (text (concatMap charToC s)) -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