-- Cmm stuff
import BlockId
-import Cmm
-import PprCmm () -- Instances only
+import OldCmm
+import OldPprCmm () -- Instances only
import CLabel
import ForeignCall
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
--
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 ]
)
-- from includes/Stg.h
--
-mkC_,mkW_,mkP_,mkPP_,mkI_,mkA_,mkD_,mkF_,mkB_,mkL_,mkLI_,mkLW_ :: SDoc
+mkC_,mkW_,mkP_ :: SDoc
mkC_ = ptext (sLit "(C_)") -- StgChar
mkW_ = ptext (sLit "(W_)") -- StgWord
mkP_ = ptext (sLit "(P_)") -- StgWord*
-mkPP_ = ptext (sLit "(PP_)") -- P_*
-mkI_ = ptext (sLit "(I_)") -- StgInt
-mkA_ = ptext (sLit "(A_)") -- StgAddr
-mkD_ = ptext (sLit "(D_)") -- const StgWord*
-mkF_ = ptext (sLit "(F_)") -- StgFunPtr
-mkB_ = ptext (sLit "(B_)") -- StgByteArray
-mkL_ = ptext (sLit "(L_)") -- StgClosurePtr
-
-mkLI_ = ptext (sLit "(LI_)") -- StgInt64
-mkLW_ = ptext (sLit "(LW_)") -- StgWord64
-
-- ---------------------------------------------------------------------
--
| 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
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
<> 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
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
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