X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FPprC.hs;h=aa7d914253100e0654a3536107d1c94bb19c3809;hp=1be886213e406ffae31f1f5d6038c93bbd5a5d8d;hb=7b5b3b0cab463e108a0132435a28ef19d17cb32b;hpb=a634a40c3e99e21cfd002cea87bcf28cb2912f3d

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 1be8862..aa7d914 100644
--- 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
@@ -44,28 +44,26 @@ import ClosureInfo
 import DynFlags
 import Unique
 import UniqSet
-import FiniteMap
 import UniqFM
 import FastString
 import Outputable
 import Constants
 import BasicTypes
 import CLabel
+import Util
 
 -- The rest
 import Data.List
 import Data.Bits
 import Data.Char
 import System.IO
+import Data.Map (Map)
+import qualified Data.Map as Map
 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
@@ -92,29 +90,30 @@ writeCs dflags handle cmms
 --
 
 pprC :: RawCmm -> SDoc
-pprC (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
+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 [
-	   text "",
+    (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 ]
     )
@@ -817,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
@@ -865,12 +853,12 @@ is_cish StdCallConv = True
 pprTempAndExternDecls :: [CmmBasicBlock] -> (SDoc{-temps-}, SDoc{-externs-})
 pprTempAndExternDecls stmts 
   = (vcat (map pprTempDecl (uniqSetToList temps)), 
-     vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls)))
+     vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls)))
   where (temps, lbls) = runTE (mapM_ te_BB stmts)
 
 pprDataExterns :: [CmmStatic] -> SDoc
 pprDataExterns statics
-  = vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls))
+  = vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls))
   where (_, lbls) = runTE (mapM_ te_Static statics)
 
 pprTempDecl :: LocalReg -> SDoc
@@ -901,7 +889,7 @@ pprExternDecl in_srt lbl
         <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType wordWidth)))
         <> semi
 
-type TEState = (UniqSet LocalReg, FiniteMap CLabel ())
+type TEState = (UniqSet LocalReg, Map CLabel ())
 newtype TE a = TE { unTE :: TEState -> (a, TEState) }
 
 instance Monad TE where
@@ -909,13 +897,13 @@ instance Monad TE where
    return a    = TE $ \s -> (a, s)
 
 te_lbl :: CLabel -> TE ()
-te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, addToFM lbls lbl ()))
+te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, Map.insert lbl () lbls))
 
 te_temp :: LocalReg -> TE ()
 te_temp r = TE $ \(temps,lbls) -> ((), (addOneToUniqSet temps r, lbls))
 
 runTE :: TE () -> TEState
-runTE (TE m) = snd (m (emptyUniqSet, emptyFM))
+runTE (TE m) = snd (m (emptyUniqSet, Map.empty))
 
 te_Static :: CmmStatic -> TE ()
 te_Static (CmmStaticLit lit) = te_Lit lit
@@ -1021,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