Merge branch 'master' of http://darcs.haskell.org/ghc

[ghc-hetmet.git] / compiler / cmm / PprC.hs

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index a36a356..aa7d914 100644 (file)
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -34,8 +34,8 @@ module PprC (
 
 -- Cmm stuff
 import BlockId
-import Cmm
-import PprCmm  ()      -- Instances only
+import OldCmm
+import OldPprCmm       ()      -- Instances only
 import CLabel
 import ForeignCall
 import ClosureInfo
@@ -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
@@ -99,23 +96,24 @@ pprC (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
 -- top level procs
 -- 
 pprTop :: RawCmmTop -> SDoc
-pprTop (CmmProc info clbl _params (ListGraph blocks)) =
+pprTop (CmmProc info clbl (ListGraph blocks)) =
     (if not (null info)
         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 ]
     )
@@ -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