summaryrefslogtreecommitdiff
path: root/compiler/GHC/CmmToAsm
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-03-11 17:41:51 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-04-29 17:29:44 -0400
commit1d03d8bef962e6789db44e8b6f2cfd9e34f3f5ad (patch)
treed77ec6ba70bc70e87e954ecb2f56cfa39d12159e /compiler/GHC/CmmToAsm
parentc2541c49f162f1d03b0ae55f47b9c76cc96df76f (diff)
downloadhaskell-1d03d8bef962e6789db44e8b6f2cfd9e34f3f5ad.tar.gz
Replace (ptext .. sLit) with `text`
1. `text` is as efficient as `ptext . sLit` thanks to the rewrite rules 2. `text` is visually nicer than `ptext . sLit` 3. `ptext . sLit` encourages using one `ptext` for several `sLit` as in: ptext $ case xy of ... -> sLit ... ... -> sLit ... which may allocate SDoc's TextBeside constructors at runtime instead of sharing them into CAFs.
Diffstat (limited to 'compiler/GHC/CmmToAsm')
-rw-r--r--compiler/GHC/CmmToAsm/CPrim.hs260
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf.hs12
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf/Constants.hs11
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf/Types.hs22
-rw-r--r--compiler/GHC/CmmToAsm/PIC.hs12
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs16
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Ppr.hs162
-rw-r--r--compiler/GHC/CmmToAsm/Ppr.hs40
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/CodeGen.hs26
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/Ppr.hs235
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs18
-rw-r--r--compiler/GHC/CmmToAsm/X86/Ppr.hs405
12 files changed, 608 insertions, 611 deletions
diff --git a/compiler/GHC/CmmToAsm/CPrim.hs b/compiler/GHC/CmmToAsm/CPrim.hs
index 4de946686d..fa05bd0e59 100644
--- a/compiler/GHC/CmmToAsm/CPrim.hs
+++ b/compiler/GHC/CmmToAsm/CPrim.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
-- | Generating C symbol names emitted by the compiler.
module GHC.CmmToAsm.CPrim
( atomicReadLabel
@@ -15,130 +17,144 @@ module GHC.CmmToAsm.CPrim
, word2FloatLabel
) where
-import GHC.Prelude
-
import GHC.Cmm.Type
import GHC.Cmm.MachOp
+import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
-popCntLabel :: Width -> String
-popCntLabel w = "hs_popcnt" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "popCntLabel: Unsupported word width " (ppr w)
-
-pdepLabel :: Width -> String
-pdepLabel w = "hs_pdep" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "pdepLabel: Unsupported word width " (ppr w)
-
-pextLabel :: Width -> String
-pextLabel w = "hs_pext" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "pextLabel: Unsupported word width " (ppr w)
-
-bSwapLabel :: Width -> String
-bSwapLabel w = "hs_bswap" ++ pprWidth w
- where
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "bSwapLabel: Unsupported word width " (ppr w)
-
-bRevLabel :: Width -> String
-bRevLabel w = "hs_bitrev" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "bRevLabel: Unsupported word width " (ppr w)
-
-clzLabel :: Width -> String
-clzLabel w = "hs_clz" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "clzLabel: Unsupported word width " (ppr w)
-
-ctzLabel :: Width -> String
-ctzLabel w = "hs_ctz" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "ctzLabel: Unsupported word width " (ppr w)
-
-word2FloatLabel :: Width -> String
-word2FloatLabel w = "hs_word2float" ++ pprWidth w
- where
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "word2FloatLabel: Unsupported word width " (ppr w)
-
-atomicRMWLabel :: Width -> AtomicMachOp -> String
-atomicRMWLabel w amop = "hs_atomic_" ++ pprFunName amop ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
-
- pprFunName AMO_Add = "add"
- pprFunName AMO_Sub = "sub"
- pprFunName AMO_And = "and"
- pprFunName AMO_Nand = "nand"
- pprFunName AMO_Or = "or"
- pprFunName AMO_Xor = "xor"
-
-xchgLabel :: Width -> String
-xchgLabel w = "hs_xchg" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "xchgLabel: Unsupported word width " (ppr w)
-
-cmpxchgLabel :: Width -> String
-cmpxchgLabel w = "hs_cmpxchg" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "cmpxchgLabel: Unsupported word width " (ppr w)
-
-atomicReadLabel :: Width -> String
-atomicReadLabel w = "hs_atomicread" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "atomicReadLabel: Unsupported word width " (ppr w)
-
-atomicWriteLabel :: Width -> String
-atomicWriteLabel w = "hs_atomicwrite" ++ pprWidth w
- where
- pprWidth W8 = "8"
- pprWidth W16 = "16"
- pprWidth W32 = "32"
- pprWidth W64 = "64"
- pprWidth w = pprPanic "atomicWriteLabel: Unsupported word width " (ppr w)
+popCntLabel :: Width -> FastString
+popCntLabel = \case
+ W8 -> fsLit "hs_popcnt8"
+ W16 -> fsLit "hs_popcnt16"
+ W32 -> fsLit "hs_popcnt32"
+ W64 -> fsLit "hs_popcnt64"
+ w -> pprPanic "popCntLabel: Unsupported word width " (ppr w)
+
+pdepLabel :: Width -> FastString
+pdepLabel = \case
+ W8 -> fsLit "hs_pdep8"
+ W16 -> fsLit "hs_pdep16"
+ W32 -> fsLit "hs_pdep32"
+ W64 -> fsLit "hs_pdep64"
+ w -> pprPanic "pdepLabel: Unsupported word width " (ppr w)
+
+pextLabel :: Width -> FastString
+pextLabel = \case
+ W8 -> fsLit "hs_pext8"
+ W16 -> fsLit "hs_pext16"
+ W32 -> fsLit "hs_pext32"
+ W64 -> fsLit "hs_pext64"
+ w -> pprPanic "pextLabel: Unsupported word width " (ppr w)
+
+bSwapLabel :: Width -> FastString
+bSwapLabel = \case
+ W16 -> fsLit "hs_bswap16"
+ W32 -> fsLit "hs_bswap32"
+ W64 -> fsLit "hs_bswap64"
+ w -> pprPanic "bSwapLabel: Unsupported word width " (ppr w)
+
+bRevLabel :: Width -> FastString
+bRevLabel = \case
+ W8 -> fsLit "hs_bitrev8"
+ W16 -> fsLit "hs_bitrev16"
+ W32 -> fsLit "hs_bitrev32"
+ W64 -> fsLit "hs_bitrev64"
+ w -> pprPanic "bRevLabel: Unsupported word width " (ppr w)
+
+clzLabel :: Width -> FastString
+clzLabel = \case
+ W8 -> fsLit "hs_clz8"
+ W16 -> fsLit "hs_clz16"
+ W32 -> fsLit "hs_clz32"
+ W64 -> fsLit "hs_clz64"
+ w -> pprPanic "clzLabel: Unsupported word width " (ppr w)
+
+ctzLabel :: Width -> FastString
+ctzLabel = \case
+ W8 -> fsLit "hs_ctz8"
+ W16 -> fsLit "hs_ctz16"
+ W32 -> fsLit "hs_ctz32"
+ W64 -> fsLit "hs_ctz64"
+ w -> pprPanic "ctzLabel: Unsupported word width " (ppr w)
+
+word2FloatLabel :: Width -> FastString
+word2FloatLabel = \case
+ W32 -> fsLit "hs_word2float32"
+ W64 -> fsLit "hs_word2float64"
+ w -> pprPanic "word2FloatLabel: Unsupported word width " (ppr w)
+
+atomicRMWLabel :: Width -> AtomicMachOp -> FastString
+atomicRMWLabel w amop = case amop of
+ -- lots of boring cases, but we do it this way to get shared FastString
+ -- literals (compared to concatening strings and allocating FastStrings at
+ -- runtime)
+ AMO_Add -> case w of
+ W8 -> fsLit "hs_atomic_add8"
+ W16 -> fsLit "hs_atomic_add16"
+ W32 -> fsLit "hs_atomic_add32"
+ W64 -> fsLit "hs_atomic_add64"
+ _ -> pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
+ AMO_Sub -> case w of
+ W8 -> fsLit "hs_atomic_sub8"
+ W16 -> fsLit "hs_atomic_sub16"
+ W32 -> fsLit "hs_atomic_sub32"
+ W64 -> fsLit "hs_atomic_sub64"
+ _ -> pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
+ AMO_And -> case w of
+ W8 -> fsLit "hs_atomic_and8"
+ W16 -> fsLit "hs_atomic_and16"
+ W32 -> fsLit "hs_atomic_and32"
+ W64 -> fsLit "hs_atomic_and64"
+ _ -> pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
+ AMO_Nand -> case w of
+ W8 -> fsLit "hs_atomic_nand8"
+ W16 -> fsLit "hs_atomic_nand16"
+ W32 -> fsLit "hs_atomic_nand32"
+ W64 -> fsLit "hs_atomic_nand64"
+ _ -> pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
+ AMO_Or -> case w of
+ W8 -> fsLit "hs_atomic_or8"
+ W16 -> fsLit "hs_atomic_or16"
+ W32 -> fsLit "hs_atomic_or32"
+ W64 -> fsLit "hs_atomic_or64"
+ _ -> pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
+ AMO_Xor -> case w of
+ W8 -> fsLit "hs_atomic_xor8"
+ W16 -> fsLit "hs_atomic_xor16"
+ W32 -> fsLit "hs_atomic_xor32"
+ W64 -> fsLit "hs_atomic_xor64"
+ _ -> pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
+
+
+xchgLabel :: Width -> FastString
+xchgLabel = \case
+ W8 -> fsLit "hs_xchg8"
+ W16 -> fsLit "hs_xchg16"
+ W32 -> fsLit "hs_xchg32"
+ W64 -> fsLit "hs_xchg64"
+ w -> pprPanic "xchgLabel: Unsupported word width " (ppr w)
+
+cmpxchgLabel :: Width -> FastString
+cmpxchgLabel = \case
+ W8 -> fsLit "hs_cmpxchg8"
+ W16 -> fsLit "hs_cmpxchg16"
+ W32 -> fsLit "hs_cmpxchg32"
+ W64 -> fsLit "hs_cmpxchg64"
+ w -> pprPanic "cmpxchgLabel: Unsupported word width " (ppr w)
+
+atomicReadLabel :: Width -> FastString
+atomicReadLabel = \case
+ W8 -> fsLit "hs_atomicread8"
+ W16 -> fsLit "hs_atomicread16"
+ W32 -> fsLit "hs_atomicread32"
+ W64 -> fsLit "hs_atomicread64"
+ w -> pprPanic "atomicReadLabel: Unsupported word width " (ppr w)
+
+atomicWriteLabel :: Width -> FastString
+atomicWriteLabel = \case
+ W8 -> fsLit "hs_atomicwrite8"
+ W16 -> fsLit "hs_atomicwrite16"
+ W32 -> fsLit "hs_atomicwrite32"
+ W64 -> fsLit "hs_atomicwrite64"
+ w -> pprPanic "atomicWriteLabel: Unsupported word width " (ppr w)
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index 9b48d25bf4..fcff4be74e 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -51,8 +51,8 @@ dwarfGen config modLoc us blocks = do
, dwName = fromMaybe "" (ml_hs_file modLoc)
, dwCompDir = addTrailingPathSeparator compPath
, dwProducer = cProjectName ++ " " ++ cProjectVersion
- , dwLowLabel = lowLabel
- , dwHighLabel = highLabel
+ , dwLowLabel = pdoc platform lowLabel
+ , dwHighLabel = pdoc platform highLabel
, dwLineLabel = dwarfLineLabel
}
@@ -69,7 +69,7 @@ dwarfGen config modLoc us blocks = do
-- .debug_info section: Information records on procedures and blocks
let -- unique to identify start and end compilation unit .debug_inf
(unitU, us') = takeUniqFromSupply us
- infoSct = vcat [ ptext dwarfInfoLabel <> colon
+ infoSct = vcat [ dwarfInfoLabel <> colon
, dwarfInfoSection platform
, compileUnitHeader platform unitU
, pprDwarfInfo platform haveSrc dwarfUnit
@@ -79,12 +79,12 @@ dwarfGen config modLoc us blocks = do
-- .debug_line section: Generated mainly by the assembler, but we
-- need to label it
let lineSct = dwarfLineSection platform $$
- ptext dwarfLineLabel <> colon
+ dwarfLineLabel <> colon
-- .debug_frame section: Information about the layout of the GHC stack
let (framesU, us'') = takeUniqFromSupply us'
frameSct = dwarfFrameSection platform $$
- ptext dwarfFrameLabel <> colon $$
+ dwarfFrameLabel <> colon $$
pprDwarfFrame platform (debugFrame framesU procs)
-- .aranges section: Information about the bounds of compilation units
@@ -114,7 +114,7 @@ compileUnitHeader platform unitU =
in vcat [ pdoc platform cuLabel <> colon
, text "\t.long " <> length -- compilation unit size
, pprHalf 3 -- DWARF version
- , sectionOffset platform (ptext dwarfAbbrevLabel) (ptext dwarfAbbrevLabel)
+ , sectionOffset platform dwarfAbbrevLabel dwarfAbbrevLabel
-- abbrevs offset
, text "\t.byte " <> ppr (platformWordSizeInBytes platform) -- word size
]
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs b/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
index ded0ea3237..e9047256e8 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
@@ -6,7 +6,6 @@ module GHC.CmmToAsm.Dwarf.Constants where
import GHC.Prelude
import GHC.Utils.Asm
-import GHC.Data.FastString
import GHC.Platform
import GHC.Utils.Outputable
@@ -165,11 +164,11 @@ dwarfSection platform name =
-> text "\t.section .debug_" <> text name <> text ",\"dr\""
-- * Dwarf section labels
-dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: PtrString
-dwarfInfoLabel = sLit ".Lsection_info"
-dwarfAbbrevLabel = sLit ".Lsection_abbrev"
-dwarfLineLabel = sLit ".Lsection_line"
-dwarfFrameLabel = sLit ".Lsection_frame"
+dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: SDoc
+dwarfInfoLabel = text ".Lsection_info"
+dwarfAbbrevLabel = text ".Lsection_abbrev"
+dwarfLineLabel = text ".Lsection_line"
+dwarfFrameLabel = text ".Lsection_frame"
-- | Mapping of registers to DWARF register numbers
dwarfRegNo :: Platform -> Reg -> Word8
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index 43d902d106..b607d1d45e 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -59,9 +59,9 @@ data DwarfInfo
, dwName :: String
, dwProducer :: String
, dwCompDir :: String
- , dwLowLabel :: CLabel
- , dwHighLabel :: CLabel
- , dwLineLabel :: PtrString }
+ , dwLowLabel :: SDoc
+ , dwHighLabel :: SDoc
+ , dwLineLabel :: SDoc }
| DwarfSubprogram { dwChildren :: [DwarfInfo]
, dwName :: String
, dwLabel :: CLabel
@@ -111,7 +111,7 @@ pprAbbrevDecls platform haveDebugLine =
, (dW_AT_frame_base, dW_FORM_block1)
]
in dwarfAbbrevSection platform $$
- ptext dwarfAbbrevLabel <> colon $$
+ dwarfAbbrevLabel <> colon $$
mkAbbrev DwAbbrCompileUnit dW_TAG_compile_unit dW_CHILDREN_yes
([(dW_AT_name, dW_FORM_string)
, (dW_AT_producer, dW_FORM_string)
@@ -178,10 +178,10 @@ pprDwarfInfoOpen platform haveSrc (DwarfCompileUnit _ name producer compDir lowL
$$ pprData4 dW_LANG_Haskell
$$ pprString compDir
-- Offset due to Note [Info Offset]
- $$ pprWord platform (pdoc platform lowLabel <> text "-1")
- $$ pprWord platform (pdoc platform highLabel)
+ $$ pprWord platform (lowLabel <> text "-1")
+ $$ pprWord platform highLabel
$$ if haveSrc
- then sectionOffset platform (ptext lineLbl) (ptext dwarfLineLabel)
+ then sectionOffset platform lineLbl dwarfLineLabel
else empty
pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) =
pdoc platform (mkAsmTempDieLabel label) <> colon
@@ -199,7 +199,7 @@ pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) =
abbrev = case parent of Nothing -> DwAbbrSubprogram
Just _ -> DwAbbrSubprogramWithParent
parentValue = maybe empty pprParentDie parent
- pprParentDie sym = sectionOffset platform (pdoc platform sym) (ptext dwarfInfoLabel)
+ pprParentDie sym = sectionOffset platform (pdoc platform sym) dwarfInfoLabel
pprDwarfInfoOpen platform _ (DwarfBlock _ label Nothing) =
pdoc platform (mkAsmTempDieLabel label) <> colon
$$ pprAbbrev DwAbbrBlockWithoutCode
@@ -245,8 +245,7 @@ pprDwarfARanges platform arngs unitU =
initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize
in pprDwWord (ppr initialLength)
$$ pprHalf 2
- $$ sectionOffset platform (pdoc platform $ mkAsmTempLabel $ unitU)
- (ptext dwarfInfoLabel)
+ $$ sectionOffset platform (pdoc platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel
$$ pprByte (fromIntegral wordSize)
$$ pprByte 0
$$ pad paddingSize
@@ -364,8 +363,7 @@ pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks)
in vcat [ whenPprDebug $ text "# Unwinding for" <+> pdoc platform procLbl <> colon
, pprData4' (pdoc platform fdeEndLabel <> char '-' <> pdoc platform fdeLabel)
, pdoc platform fdeLabel <> colon
- , pprData4' (pdoc platform frameLbl <> char '-' <>
- ptext dwarfFrameLabel) -- Reference to CIE
+ , pprData4' (pdoc platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE
, pprWord platform (pdoc platform procLbl <> ifInfo "-1") -- Code pointer
, pprWord platform (pdoc platform procEnd <> char '-' <>
pdoc platform procLbl <> ifInfo "+1") -- Block byte length
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index 42cb6c3cd3..7fe90c3ec6 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -570,7 +570,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
then
vcat [
text ".symbol_stub",
- text "L" <> ppr_lbl lbl <> ptext (sLit "$stub:"),
+ text "L" <> ppr_lbl lbl <> text "$stub:",
text "\t.indirect_symbol" <+> ppr_lbl lbl,
text "\tjmp *L" <> ppr_lbl lbl
<> text "$lazy_ptr",
@@ -584,7 +584,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
vcat [
text ".section __TEXT,__picsymbolstub2,"
<> text "symbol_stubs,pure_instructions,25",
- text "L" <> ppr_lbl lbl <> ptext (sLit "$stub:"),
+ text "L" <> ppr_lbl lbl <> text "$stub:",
text "\t.indirect_symbol" <+> ppr_lbl lbl,
text "\tcall ___i686.get_pc_thunk.ax",
text "1:",
@@ -601,7 +601,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
$+$ vcat [ text ".section __DATA, __la_sym_ptr"
<> (if pic then int 2 else int 3)
<> text ",lazy_symbol_pointers",
- text "L" <> ppr_lbl lbl <> ptext (sLit "$lazy_ptr:"),
+ text "L" <> ppr_lbl lbl <> text "$lazy_ptr:",
text "\t.indirect_symbol" <+> ppr_lbl lbl,
text "\t.long L" <> ppr_lbl lbl
<> text "$stub_binder"]
@@ -679,14 +679,14 @@ pprImportedSymbol config importedLbl = case (arch,os) of
-> case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> let symbolSize = case ncgWordWidth config of
- W32 -> sLit "\t.long"
- W64 -> sLit "\t.quad"
+ W32 -> text "\t.long"
+ W64 -> text "\t.quad"
_ -> panic "Unknown wordRep in pprImportedSymbol"
in vcat [
text ".section \".got2\", \"aw\"",
text ".LC_" <> ppr_lbl lbl <> char ':',
- ptext symbolSize <+> ppr_lbl lbl ]
+ symbolSize <+> ppr_lbl lbl ]
-- PLT code stubs are generated automatically by the dynamic linker.
_ -> empty
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index f1a411ab27..953cb85ba9 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -2008,23 +2008,23 @@ genCCall' config gcp target dest_regs args
MO_F64_Acosh -> (fsLit "acosh", False)
MO_F64_Atanh -> (fsLit "atanh", False)
- MO_UF_Conv w -> (fsLit $ word2FloatLabel w, False)
+ MO_UF_Conv w -> (word2FloatLabel w, False)
MO_Memcpy _ -> (fsLit "memcpy", False)
MO_Memset _ -> (fsLit "memset", False)
MO_Memmove _ -> (fsLit "memmove", False)
MO_Memcmp _ -> (fsLit "memcmp", False)
- MO_BSwap w -> (fsLit $ bSwapLabel w, False)
- MO_BRev w -> (fsLit $ bRevLabel w, False)
- MO_PopCnt w -> (fsLit $ popCntLabel w, False)
- MO_Pdep w -> (fsLit $ pdepLabel w, False)
- MO_Pext w -> (fsLit $ pextLabel w, False)
+ MO_BSwap w -> (bSwapLabel w, False)
+ MO_BRev w -> (bRevLabel w, False)
+ MO_PopCnt w -> (popCntLabel w, False)
+ MO_Pdep w -> (pdepLabel w, False)
+ MO_Pext w -> (pextLabel w, False)
MO_Clz _ -> unsupported
MO_Ctz _ -> unsupported
MO_AtomicRMW {} -> unsupported
- MO_Cmpxchg w -> (fsLit $ cmpxchgLabel w, False)
- MO_Xchg w -> (fsLit $ xchgLabel w, False)
+ MO_Cmpxchg w -> (cmpxchgLabel w, False)
+ MO_Xchg w -> (xchgLabel w, False)
MO_AtomicRead _ -> unsupported
MO_AtomicWrite _ -> unsupported
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 7ed13b298f..336e0d1804 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -217,24 +217,24 @@ pprReg r
pprFormat :: Format -> SDoc
pprFormat x
- = ptext (case x of
- II8 -> sLit "b"
- II16 -> sLit "h"
- II32 -> sLit "w"
- II64 -> sLit "d"
- FF32 -> sLit "fs"
- FF64 -> sLit "fd")
+ = case x of
+ II8 -> text "b"
+ II16 -> text "h"
+ II32 -> text "w"
+ II64 -> text "d"
+ FF32 -> text "fs"
+ FF64 -> text "fd"
pprCond :: Cond -> SDoc
pprCond c
- = ptext (case c of {
- ALWAYS -> sLit "";
- EQQ -> sLit "eq"; NE -> sLit "ne";
- LTT -> sLit "lt"; GE -> sLit "ge";
- GTT -> sLit "gt"; LE -> sLit "le";
- LU -> sLit "lt"; GEU -> sLit "ge";
- GU -> sLit "gt"; LEU -> sLit "le"; })
+ = case c of {
+ ALWAYS -> text "";
+ EQQ -> text "eq"; NE -> text "ne";
+ LTT -> text "lt"; GE -> text "ge";
+ GTT -> text "gt"; LE -> text "le";
+ LU -> text "lt"; GEU -> text "ge";
+ GU -> text "gt"; LEU -> text "le"; }
pprImm :: Platform -> Imm -> SDoc
@@ -284,26 +284,26 @@ pprSectionAlign config sec@(Section seg _) =
pprAlignForSection :: Platform -> SectionType -> SDoc
pprAlignForSection platform seg =
let ppc64 = not $ target32Bit platform
- in ptext $ case seg of
- Text -> sLit ".align 2"
+ in case seg of
+ Text -> text ".align 2"
Data
- | ppc64 -> sLit ".align 3"
- | otherwise -> sLit ".align 2"
+ | ppc64 -> text ".align 3"
+ | otherwise -> text ".align 2"
ReadOnlyData
- | ppc64 -> sLit ".align 3"
- | otherwise -> sLit ".align 2"
+ | ppc64 -> text ".align 3"
+ | otherwise -> text ".align 2"
RelocatableReadOnlyData
- | ppc64 -> sLit ".align 3"
- | otherwise -> sLit ".align 2"
+ | ppc64 -> text ".align 3"
+ | otherwise -> text ".align 2"
UninitialisedData
- | ppc64 -> sLit ".align 3"
- | otherwise -> sLit ".align 2"
- ReadOnlyData16 -> sLit ".align 4"
+ | ppc64 -> text ".align 3"
+ | otherwise -> text ".align 2"
+ ReadOnlyData16 -> text ".align 4"
-- TODO: This is copied from the ReadOnlyData case, but it can likely be
-- made more efficient.
CString
- | ppc64 -> sLit ".align 3"
- | otherwise -> sLit ".align 2"
+ | ppc64 -> text ".align 3"
+ | otherwise -> text ".align 2"
OtherSection _ -> panic "PprMach.pprSectionAlign: unknown section"
pprDataItem :: Platform -> CmmLit -> SDoc
@@ -380,13 +380,13 @@ pprInstr platform instr = case instr of
-> hcat [
char '\t',
text "l",
- ptext (case fmt of
- II8 -> sLit "bz"
- II16 -> sLit "hz"
- II32 -> sLit "wz"
- II64 -> sLit "d"
- FF32 -> sLit "fs"
- FF64 -> sLit "fd"
+ (case fmt of
+ II8 -> text "bz"
+ II16 -> text "hz"
+ II32 -> text "wz"
+ II64 -> text "d"
+ FF32 -> text "fs"
+ FF64 -> text "fd"
),
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
@@ -422,13 +422,13 @@ pprInstr platform instr = case instr of
-> hcat [
char '\t',
text "l",
- ptext (case fmt of
- II8 -> sLit "ba"
- II16 -> sLit "ha"
- II32 -> sLit "wa"
- II64 -> sLit "d"
- FF32 -> sLit "fs"
- FF64 -> sLit "fd"
+ (case fmt of
+ II8 -> text "ba"
+ II16 -> text "ha"
+ II32 -> text "wa"
+ II64 -> text "d"
+ FF32 -> text "fs"
+ FF64 -> text "fd"
),
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
@@ -643,7 +643,7 @@ pprInstr platform instr = case instr of
]
ADD reg1 reg2 ri
- -> pprLogic platform (sLit "add") reg1 reg2 ri
+ -> pprLogic platform (text "add") reg1 reg2 ri
ADDIS reg1 reg2 imm
-> hcat [
@@ -658,22 +658,22 @@ pprInstr platform instr = case instr of
]
ADDO reg1 reg2 reg3
- -> pprLogic platform (sLit "addo") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "addo") reg1 reg2 (RIReg reg3)
ADDC reg1 reg2 reg3
- -> pprLogic platform (sLit "addc") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "addc") reg1 reg2 (RIReg reg3)
ADDE reg1 reg2 reg3
- -> pprLogic platform (sLit "adde") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "adde") reg1 reg2 (RIReg reg3)
ADDZE reg1 reg2
- -> pprUnary (sLit "addze") reg1 reg2
+ -> pprUnary (text "addze") reg1 reg2
SUBF reg1 reg2 reg3
- -> pprLogic platform (sLit "subf") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "subf") reg1 reg2 (RIReg reg3)
SUBFO reg1 reg2 reg3
- -> pprLogic platform (sLit "subfo") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "subfo") reg1 reg2 (RIReg reg3)
SUBFC reg1 reg2 ri
-> hcat [
@@ -691,7 +691,7 @@ pprInstr platform instr = case instr of
]
SUBFE reg1 reg2 reg3
- -> pprLogic platform (sLit "subfe") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "subfe") reg1 reg2 (RIReg reg3)
MULL fmt reg1 reg2 ri
-> pprMul platform fmt reg1 reg2 ri
@@ -773,19 +773,19 @@ pprInstr platform instr = case instr of
]
AND reg1 reg2 ri
- -> pprLogic platform (sLit "and") reg1 reg2 ri
+ -> pprLogic platform (text "and") reg1 reg2 ri
ANDC reg1 reg2 reg3
- -> pprLogic platform (sLit "andc") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "andc") reg1 reg2 (RIReg reg3)
NAND reg1 reg2 reg3
- -> pprLogic platform (sLit "nand") reg1 reg2 (RIReg reg3)
+ -> pprLogic platform (text "nand") reg1 reg2 (RIReg reg3)
OR reg1 reg2 ri
- -> pprLogic platform (sLit "or") reg1 reg2 ri
+ -> pprLogic platform (text "or") reg1 reg2 ri
XOR reg1 reg2 ri
- -> pprLogic platform (sLit "xor") reg1 reg2 ri
+ -> pprLogic platform (text "xor") reg1 reg2 ri
ORIS reg1 reg2 imm
-> hcat [
@@ -837,10 +837,10 @@ pprInstr platform instr = case instr of
]
NEG reg1 reg2
- -> pprUnary (sLit "neg") reg1 reg2
+ -> pprUnary (text "neg") reg1 reg2
NOT reg1 reg2
- -> pprUnary (sLit "not") reg1 reg2
+ -> pprUnary (text "not") reg1 reg2
SR II32 reg1 reg2 (RIImm (ImmInt i))
-- Handle the case where we are asked to shift a 32 bit register by
@@ -864,24 +864,24 @@ pprInstr platform instr = case instr of
SL fmt reg1 reg2 ri
-> let op = case fmt of
- II32 -> "slw"
- II64 -> "sld"
+ II32 -> text "slw"
+ II64 -> text "sld"
_ -> panic "PPC.Ppr.pprInstr: shift illegal size"
- in pprLogic platform (sLit op) reg1 reg2 (limitShiftRI fmt ri)
+ in pprLogic platform op reg1 reg2 (limitShiftRI fmt ri)
SR fmt reg1 reg2 ri
-> let op = case fmt of
- II32 -> "srw"
- II64 -> "srd"
+ II32 -> text "srw"
+ II64 -> text "srd"
_ -> panic "PPC.Ppr.pprInstr: shift illegal size"
- in pprLogic platform (sLit op) reg1 reg2 (limitShiftRI fmt ri)
+ in pprLogic platform op reg1 reg2 (limitShiftRI fmt ri)
SRA fmt reg1 reg2 ri
-> let op = case fmt of
- II32 -> "sraw"
- II64 -> "srad"
+ II32 -> text "sraw"
+ II64 -> text "srad"
_ -> panic "PPC.Ppr.pprInstr: shift illegal size"
- in pprLogic platform (sLit op) reg1 reg2 (limitShiftRI fmt ri)
+ in pprLogic platform op reg1 reg2 (limitShiftRI fmt ri)
RLWINM reg1 reg2 sh mb me
-> hcat [
@@ -922,22 +922,22 @@ pprInstr platform instr = case instr of
]
FADD fmt reg1 reg2 reg3
- -> pprBinaryF (sLit "fadd") fmt reg1 reg2 reg3
+ -> pprBinaryF (text "fadd") fmt reg1 reg2 reg3
FSUB fmt reg1 reg2 reg3
- -> pprBinaryF (sLit "fsub") fmt reg1 reg2 reg3
+ -> pprBinaryF (text "fsub") fmt reg1 reg2 reg3
FMUL fmt reg1 reg2 reg3
- -> pprBinaryF (sLit "fmul") fmt reg1 reg2 reg3
+ -> pprBinaryF (text "fmul") fmt reg1 reg2 reg3
FDIV fmt reg1 reg2 reg3
- -> pprBinaryF (sLit "fdiv") fmt reg1 reg2 reg3
+ -> pprBinaryF (text "fdiv") fmt reg1 reg2 reg3
FABS reg1 reg2
- -> pprUnary (sLit "fabs") reg1 reg2
+ -> pprUnary (text "fabs") reg1 reg2
FNEG reg1 reg2
- -> pprUnary (sLit "fneg") reg1 reg2
+ -> pprUnary (text "fneg") reg1 reg2
FCMP reg1 reg2
-> hcat [
@@ -956,16 +956,16 @@ pprInstr platform instr = case instr of
]
FCTIWZ reg1 reg2
- -> pprUnary (sLit "fctiwz") reg1 reg2
+ -> pprUnary (text "fctiwz") reg1 reg2
FCTIDZ reg1 reg2
- -> pprUnary (sLit "fctidz") reg1 reg2
+ -> pprUnary (text "fctidz") reg1 reg2
FCFID reg1 reg2
- -> pprUnary (sLit "fcfid") reg1 reg2
+ -> pprUnary (text "fcfid") reg1 reg2
FRSP reg1 reg2
- -> pprUnary (sLit "frsp") reg1 reg2
+ -> pprUnary (text "frsp") reg1 reg2
CRNOR dst src1 src2
-> hcat [
@@ -1011,10 +1011,10 @@ pprInstr platform instr = case instr of
NOP
-> text "\tnop"
-pprLogic :: Platform -> PtrString -> Reg -> Reg -> RI -> SDoc
+pprLogic :: Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic platform op reg1 reg2 ri = hcat [
char '\t',
- ptext op,
+ op,
case ri of
RIReg _ -> empty
RIImm _ -> char 'i',
@@ -1064,10 +1064,10 @@ pprDiv fmt sgn reg1 reg2 reg3 = hcat [
]
-pprUnary :: PtrString -> Reg -> Reg -> SDoc
+pprUnary :: SDoc -> Reg -> Reg -> SDoc
pprUnary op reg1 reg2 = hcat [
char '\t',
- ptext op,
+ op,
char '\t',
pprReg reg1,
text ", ",
@@ -1075,10 +1075,10 @@ pprUnary op reg1 reg2 = hcat [
]
-pprBinaryF :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
+pprBinaryF :: SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF op fmt reg1 reg2 reg3 = hcat [
char '\t',
- ptext op,
+ op,
pprFFormat fmt,
char '\t',
pprReg reg1,
diff --git a/compiler/GHC/CmmToAsm/Ppr.hs b/compiler/GHC/CmmToAsm/Ppr.hs
index a2382705ae..e4e9d7708e 100644
--- a/compiler/GHC/CmmToAsm/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/Ppr.hs
@@ -24,7 +24,6 @@ import GHC.Utils.Asm
import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.CmmToAsm.Config
-import GHC.Data.FastString
import GHC.Utils.Outputable as SDoc
import qualified GHC.Utils.Ppr as Pretty
import GHC.Utils.Panic
@@ -243,26 +242,23 @@ pprGNUSectionHeader config t suffix =
-- XCOFF doesn't support relocating label-differences, so we place all
-- RO sections into .text[PR] sections
pprXcoffSectionHeader :: SectionType -> SDoc
-pprXcoffSectionHeader t = text $ case t of
- Text -> ".csect .text[PR]"
- Data -> ".csect .data[RW]"
- ReadOnlyData -> ".csect .text[PR] # ReadOnlyData"
- RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
- ReadOnlyData16 -> ".csect .text[PR] # ReadOnlyData16"
- CString -> ".csect .text[PR] # CString"
- UninitialisedData -> ".csect .data[BS]"
- OtherSection _ ->
- panic "PprBase.pprXcoffSectionHeader: unknown section type"
+pprXcoffSectionHeader t = case t of
+ Text -> text ".csect .text[PR]"
+ Data -> text ".csect .data[RW]"
+ ReadOnlyData -> text ".csect .text[PR] # ReadOnlyData"
+ RelocatableReadOnlyData -> text ".csect .text[PR] # RelocatableReadOnlyData"
+ ReadOnlyData16 -> text ".csect .text[PR] # ReadOnlyData16"
+ CString -> text ".csect .text[PR] # CString"
+ UninitialisedData -> text ".csect .data[BS]"
+ OtherSection _ -> panic "pprXcoffSectionHeader: unknown section type"
pprDarwinSectionHeader :: SectionType -> SDoc
-pprDarwinSectionHeader t =
- ptext $ case t of
- Text -> sLit ".text"
- Data -> sLit ".data"
- ReadOnlyData -> sLit ".const"
- RelocatableReadOnlyData -> sLit ".const_data"
- UninitialisedData -> sLit ".data"
- ReadOnlyData16 -> sLit ".const"
- CString -> sLit ".section\t__TEXT,__cstring,cstring_literals"
- OtherSection _ ->
- panic "PprBase.pprDarwinSectionHeader: unknown section type"
+pprDarwinSectionHeader t = case t of
+ Text -> text ".text"
+ Data -> text ".data"
+ ReadOnlyData -> text ".const"
+ RelocatableReadOnlyData -> text ".const_data"
+ UninitialisedData -> text ".data"
+ ReadOnlyData16 -> text ".const"
+ CString -> text ".section\t__TEXT,__cstring,cstring_literals"
+ OtherSection _ -> panic "pprDarwinSectionHeader: unknown section type"
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index c06d4178ad..21313aa0bd 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -660,25 +660,25 @@ outOfLineMachOp_table mop
MO_F64_Acosh -> fsLit "acosh"
MO_F64_Atanh -> fsLit "atanh"
- MO_UF_Conv w -> fsLit $ word2FloatLabel w
+ MO_UF_Conv w -> word2FloatLabel w
MO_Memcpy _ -> fsLit "memcpy"
MO_Memset _ -> fsLit "memset"
MO_Memmove _ -> fsLit "memmove"
MO_Memcmp _ -> fsLit "memcmp"
- MO_BSwap w -> fsLit $ bSwapLabel w
- MO_BRev w -> fsLit $ bRevLabel w
- MO_PopCnt w -> fsLit $ popCntLabel w
- MO_Pdep w -> fsLit $ pdepLabel w
- MO_Pext w -> fsLit $ pextLabel w
- MO_Clz w -> fsLit $ clzLabel w
- MO_Ctz w -> fsLit $ ctzLabel w
- MO_AtomicRMW w amop -> fsLit $ atomicRMWLabel w amop
- MO_Cmpxchg w -> fsLit $ cmpxchgLabel w
- MO_Xchg w -> fsLit $ xchgLabel w
- MO_AtomicRead w -> fsLit $ atomicReadLabel w
- MO_AtomicWrite w -> fsLit $ atomicWriteLabel w
+ MO_BSwap w -> bSwapLabel w
+ MO_BRev w -> bRevLabel w
+ MO_PopCnt w -> popCntLabel w
+ MO_Pdep w -> pdepLabel w
+ MO_Pext w -> pextLabel w
+ MO_Clz w -> clzLabel w
+ MO_Ctz w -> ctzLabel w
+ MO_AtomicRMW w amop -> atomicRMWLabel w amop
+ MO_Cmpxchg w -> cmpxchgLabel w
+ MO_Xchg w -> xchgLabel w
+ MO_AtomicRead w -> atomicReadLabel w
+ MO_AtomicWrite w -> atomicWriteLabel w
MO_S_Mul2 {} -> unsupported
MO_S_QuotRem {} -> unsupported
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index 20b3beea35..a45d05d6c6 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -141,7 +141,7 @@ pprGloblDecl platform lbl
pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl platform lbl
= if platformOS platform == OSLinux && externallyVisibleCLabel lbl
- then text ".type " <> pdoc platform lbl <> ptext (sLit ", @object")
+ then text ".type " <> pdoc platform lbl <> text ", @object"
else empty
pprLabel :: Platform -> CLabel -> SDoc
@@ -188,92 +188,88 @@ pprReg reg
--
pprReg_ofRegNo :: Int -> SDoc
pprReg_ofRegNo i
- = ptext
- (case i of {
- 0 -> sLit "%g0"; 1 -> sLit "%g1";
- 2 -> sLit "%g2"; 3 -> sLit "%g3";
- 4 -> sLit "%g4"; 5 -> sLit "%g5";
- 6 -> sLit "%g6"; 7 -> sLit "%g7";
- 8 -> sLit "%o0"; 9 -> sLit "%o1";
- 10 -> sLit "%o2"; 11 -> sLit "%o3";
- 12 -> sLit "%o4"; 13 -> sLit "%o5";
- 14 -> sLit "%o6"; 15 -> sLit "%o7";
- 16 -> sLit "%l0"; 17 -> sLit "%l1";
- 18 -> sLit "%l2"; 19 -> sLit "%l3";
- 20 -> sLit "%l4"; 21 -> sLit "%l5";
- 22 -> sLit "%l6"; 23 -> sLit "%l7";
- 24 -> sLit "%i0"; 25 -> sLit "%i1";
- 26 -> sLit "%i2"; 27 -> sLit "%i3";
- 28 -> sLit "%i4"; 29 -> sLit "%i5";
- 30 -> sLit "%i6"; 31 -> sLit "%i7";
- 32 -> sLit "%f0"; 33 -> sLit "%f1";
- 34 -> sLit "%f2"; 35 -> sLit "%f3";
- 36 -> sLit "%f4"; 37 -> sLit "%f5";
- 38 -> sLit "%f6"; 39 -> sLit "%f7";
- 40 -> sLit "%f8"; 41 -> sLit "%f9";
- 42 -> sLit "%f10"; 43 -> sLit "%f11";
- 44 -> sLit "%f12"; 45 -> sLit "%f13";
- 46 -> sLit "%f14"; 47 -> sLit "%f15";
- 48 -> sLit "%f16"; 49 -> sLit "%f17";
- 50 -> sLit "%f18"; 51 -> sLit "%f19";
- 52 -> sLit "%f20"; 53 -> sLit "%f21";
- 54 -> sLit "%f22"; 55 -> sLit "%f23";
- 56 -> sLit "%f24"; 57 -> sLit "%f25";
- 58 -> sLit "%f26"; 59 -> sLit "%f27";
- 60 -> sLit "%f28"; 61 -> sLit "%f29";
- 62 -> sLit "%f30"; 63 -> sLit "%f31";
- _ -> sLit "very naughty sparc register" })
+ = case i of {
+ 0 -> text "%g0"; 1 -> text "%g1";
+ 2 -> text "%g2"; 3 -> text "%g3";
+ 4 -> text "%g4"; 5 -> text "%g5";
+ 6 -> text "%g6"; 7 -> text "%g7";
+ 8 -> text "%o0"; 9 -> text "%o1";
+ 10 -> text "%o2"; 11 -> text "%o3";
+ 12 -> text "%o4"; 13 -> text "%o5";
+ 14 -> text "%o6"; 15 -> text "%o7";
+ 16 -> text "%l0"; 17 -> text "%l1";
+ 18 -> text "%l2"; 19 -> text "%l3";
+ 20 -> text "%l4"; 21 -> text "%l5";
+ 22 -> text "%l6"; 23 -> text "%l7";
+ 24 -> text "%i0"; 25 -> text "%i1";
+ 26 -> text "%i2"; 27 -> text "%i3";
+ 28 -> text "%i4"; 29 -> text "%i5";
+ 30 -> text "%i6"; 31 -> text "%i7";
+ 32 -> text "%f0"; 33 -> text "%f1";
+ 34 -> text "%f2"; 35 -> text "%f3";
+ 36 -> text "%f4"; 37 -> text "%f5";
+ 38 -> text "%f6"; 39 -> text "%f7";
+ 40 -> text "%f8"; 41 -> text "%f9";
+ 42 -> text "%f10"; 43 -> text "%f11";
+ 44 -> text "%f12"; 45 -> text "%f13";
+ 46 -> text "%f14"; 47 -> text "%f15";
+ 48 -> text "%f16"; 49 -> text "%f17";
+ 50 -> text "%f18"; 51 -> text "%f19";
+ 52 -> text "%f20"; 53 -> text "%f21";
+ 54 -> text "%f22"; 55 -> text "%f23";
+ 56 -> text "%f24"; 57 -> text "%f25";
+ 58 -> text "%f26"; 59 -> text "%f27";
+ 60 -> text "%f28"; 61 -> text "%f29";
+ 62 -> text "%f30"; 63 -> text "%f31";
+ _ -> text "very naughty sparc register" }
-- | Pretty print a format for an instruction suffix.
pprFormat :: Format -> SDoc
pprFormat x
- = ptext
- (case x of
- II8 -> sLit "ub"
- II16 -> sLit "uh"
- II32 -> sLit ""
- II64 -> sLit "d"
- FF32 -> sLit ""
- FF64 -> sLit "d")
+ = case x of
+ II8 -> text "ub"
+ II16 -> text "uh"
+ II32 -> text ""
+ II64 -> text "d"
+ FF32 -> text ""
+ FF64 -> text "d"
-- | Pretty print a format for an instruction suffix.
-- eg LD is 32bit on sparc, but LDD is 64 bit.
pprStFormat :: Format -> SDoc
pprStFormat x
- = ptext
- (case x of
- II8 -> sLit "b"
- II16 -> sLit "h"
- II32 -> sLit ""
- II64 -> sLit "x"
- FF32 -> sLit ""
- FF64 -> sLit "d")
+ = case x of
+ II8 -> text "b"
+ II16 -> text "h"
+ II32 -> text ""
+ II64 -> text "x"
+ FF32 -> text ""
+ FF64 -> text "d"
-- | Pretty print a condition code.
pprCond :: Cond -> SDoc
pprCond c
- = ptext
- (case c of
- ALWAYS -> sLit ""
- NEVER -> sLit "n"
- GEU -> sLit "geu"
- LU -> sLit "lu"
- EQQ -> sLit "e"
- GTT -> sLit "g"
- GE -> sLit "ge"
- GU -> sLit "gu"
- LTT -> sLit "l"
- LE -> sLit "le"
- LEU -> sLit "leu"
- NE -> sLit "ne"
- NEG -> sLit "neg"
- POS -> sLit "pos"
- VC -> sLit "vc"
- VS -> sLit "vs")
+ = case c of
+ ALWAYS -> text ""
+ NEVER -> text "n"
+ GEU -> text "geu"
+ LU -> text "lu"
+ EQQ -> text "e"
+ GTT -> text "g"
+ GE -> text "ge"
+ GU -> text "gu"
+ LTT -> text "l"
+ LE -> text "le"
+ LEU -> text "leu"
+ NE -> text "ne"
+ NEG -> text "neg"
+ POS -> text "pos"
+ VC -> text "vc"
+ VS -> text "vs"
-- | Pretty print an address mode.
@@ -344,18 +340,17 @@ pprSectionAlign config sec@(Section seg _) =
-- | Print appropriate alignment for the given section type.
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection seg =
- ptext (case seg of
- Text -> sLit ".align 4"
- Data -> sLit ".align 8"
- ReadOnlyData -> sLit ".align 8"
- RelocatableReadOnlyData
- -> sLit ".align 8"
- UninitialisedData -> sLit ".align 8"
- ReadOnlyData16 -> sLit ".align 16"
+ case seg of
+ Text -> text ".align 4"
+ Data -> text ".align 8"
+ ReadOnlyData -> text ".align 8"
+ RelocatableReadOnlyData -> text ".align 8"
+ UninitialisedData -> text ".align 8"
+ ReadOnlyData16 -> text ".align 16"
-- TODO: This is copied from the ReadOnlyData case, but it can likely be
-- made more efficient.
- CString -> sLit ".align 8"
- OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section")
+ CString -> text ".align 8"
+ OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
-- | Pretty print a data item.
pprDataItem :: Platform -> CmmLit -> SDoc
@@ -447,7 +442,7 @@ pprInstr platform = \case
-> hcat [ text "\tmov\t", pprReg reg1, comma, pprReg reg2 ]
| otherwise
- -> pprRegRIReg platform (if x then sLit "addx" else sLit "add") cc reg1 ri reg2
+ -> pprRegRIReg platform (if x then text "addx" else text "add") cc reg1 ri reg2
SUB x cc reg1 ri reg2
@@ -458,11 +453,11 @@ pprInstr platform = \case
-> hcat [ text "\tmov\t", pprReg reg1, comma, pprReg reg2 ]
| otherwise
- -> pprRegRIReg platform (if x then sLit "subx" else sLit "sub") cc reg1 ri reg2
+ -> pprRegRIReg platform (if x then text "subx" else text "sub") cc reg1 ri reg2
- AND b reg1 ri reg2 -> pprRegRIReg platform (sLit "and") b reg1 ri reg2
+ AND b reg1 ri reg2 -> pprRegRIReg platform (text "and") b reg1 ri reg2
- ANDN b reg1 ri reg2 -> pprRegRIReg platform (sLit "andn") b reg1 ri reg2
+ ANDN b reg1 ri reg2 -> pprRegRIReg platform (text "andn") b reg1 ri reg2
OR b reg1 ri reg2
| not b && reg1 == g0
@@ -472,16 +467,16 @@ pprInstr platform = \case
_ -> doit
| otherwise
- -> pprRegRIReg platform (sLit "or") b reg1 ri reg2
+ -> pprRegRIReg platform (text "or") b reg1 ri reg2
- ORN b reg1 ri reg2 -> pprRegRIReg platform (sLit "orn") b reg1 ri reg2
+ ORN b reg1 ri reg2 -> pprRegRIReg platform (text "orn") b reg1 ri reg2
- XOR b reg1 ri reg2 -> pprRegRIReg platform (sLit "xor") b reg1 ri reg2
- XNOR b reg1 ri reg2 -> pprRegRIReg platform (sLit "xnor") b reg1 ri reg2
+ XOR b reg1 ri reg2 -> pprRegRIReg platform (text "xor") b reg1 ri reg2
+ XNOR b reg1 ri reg2 -> pprRegRIReg platform (text "xnor") b reg1 ri reg2
- SLL reg1 ri reg2 -> pprRegRIReg platform (sLit "sll") False reg1 ri reg2
- SRL reg1 ri reg2 -> pprRegRIReg platform (sLit "srl") False reg1 ri reg2
- SRA reg1 ri reg2 -> pprRegRIReg platform (sLit "sra") False reg1 ri reg2
+ SLL reg1 ri reg2 -> pprRegRIReg platform (text "sll") False reg1 ri reg2
+ SRL reg1 ri reg2 -> pprRegRIReg platform (text "srl") False reg1 ri reg2
+ SRA reg1 ri reg2 -> pprRegRIReg platform (text "sra") False reg1 ri reg2
RDY rd -> text "\trd\t%y," <> pprReg rd
WRY reg1 reg2
@@ -492,10 +487,10 @@ pprInstr platform = \case
<> char ','
<> text "%y"
- SMUL b reg1 ri reg2 -> pprRegRIReg platform (sLit "smul") b reg1 ri reg2
- UMUL b reg1 ri reg2 -> pprRegRIReg platform (sLit "umul") b reg1 ri reg2
- SDIV b reg1 ri reg2 -> pprRegRIReg platform (sLit "sdiv") b reg1 ri reg2
- UDIV b reg1 ri reg2 -> pprRegRIReg platform (sLit "udiv") b reg1 ri reg2
+ SMUL b reg1 ri reg2 -> pprRegRIReg platform (text "smul") b reg1 ri reg2
+ UMUL b reg1 ri reg2 -> pprRegRIReg platform (text "umul") b reg1 ri reg2
+ SDIV b reg1 ri reg2 -> pprRegRIReg platform (text "sdiv") b reg1 ri reg2
+ UDIV b reg1 ri reg2 -> pprRegRIReg platform (text "udiv") b reg1 ri reg2
SETHI imm reg
-> hcat [
@@ -508,48 +503,46 @@ pprInstr platform = \case
NOP -> text "\tnop"
FABS format reg1 reg2
- -> pprFormatRegReg (sLit "fabs") format reg1 reg2
+ -> pprFormatRegReg (text "fabs") format reg1 reg2
FADD format reg1 reg2 reg3
- -> pprFormatRegRegReg (sLit "fadd") format reg1 reg2 reg3
+ -> pprFormatRegRegReg (text "fadd") format reg1 reg2 reg3
FCMP e format reg1 reg2
- -> pprFormatRegReg (if e then sLit "fcmpe" else sLit "fcmp")
+ -> pprFormatRegReg (if e then text "fcmpe" else text "fcmp")
format reg1 reg2
FDIV format reg1 reg2 reg3
- -> pprFormatRegRegReg (sLit "fdiv") format reg1 reg2 reg3
+ -> pprFormatRegRegReg (text "fdiv") format reg1 reg2 reg3
FMOV format reg1 reg2
- -> pprFormatRegReg (sLit "fmov") format reg1 reg2
+ -> pprFormatRegReg (text "fmov") format reg1 reg2
FMUL format reg1 reg2 reg3
- -> pprFormatRegRegReg (sLit "fmul") format reg1 reg2 reg3
+ -> pprFormatRegRegReg (text "fmul") format reg1 reg2 reg3
FNEG format reg1 reg2
- -> pprFormatRegReg (sLit "fneg") format reg1 reg2
+ -> pprFormatRegReg (text "fneg") format reg1 reg2
FSQRT format reg1 reg2
- -> pprFormatRegReg (sLit "fsqrt") format reg1 reg2
+ -> pprFormatRegReg (text "fsqrt") format reg1 reg2
FSUB format reg1 reg2 reg3
- -> pprFormatRegRegReg (sLit "fsub") format reg1 reg2 reg3
+ -> pprFormatRegRegReg (text "fsub") format reg1 reg2 reg3
FxTOy format1 format2 reg1 reg2
-> hcat [
text "\tf",
- ptext
(case format1 of
- II32 -> sLit "ito"
- FF32 -> sLit "sto"
- FF64 -> sLit "dto"
+ II32 -> text "ito"
+ FF32 -> text "sto"
+ FF64 -> text "dto"
_ -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
- ptext
(case format2 of
- II32 -> sLit "i\t"
- II64 -> sLit "x\t"
- FF32 -> sLit "s\t"
- FF64 -> sLit "d\t"
+ II32 -> text "i\t"
+ II64 -> text "x\t"
+ FF32 -> text "s\t"
+ FF64 -> text "d\t"
_ -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
pprReg reg1, comma, pprReg reg2
]
@@ -589,11 +582,11 @@ pprRI platform = \case
-- | Pretty print a two reg instruction.
-pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
+pprFormatRegReg :: SDoc -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg name format reg1 reg2
= hcat [
char '\t',
- ptext name,
+ name,
(case format of
FF32 -> text "s\t"
FF64 -> text "d\t"
@@ -606,11 +599,11 @@ pprFormatRegReg name format reg1 reg2
-- | Pretty print a three reg instruction.
-pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
+pprFormatRegRegReg :: SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg name format reg1 reg2 reg3
= hcat [
char '\t',
- ptext name,
+ name,
(case format of
FF32 -> text "s\t"
FF64 -> text "d\t"
@@ -624,11 +617,11 @@ pprFormatRegRegReg name format reg1 reg2 reg3
-- | Pretty print an instruction of two regs and a ri.
-pprRegRIReg :: Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
+pprRegRIReg :: Platform -> SDoc -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg platform name b reg1 ri reg2
= hcat [
char '\t',
- ptext name,
+ name,
if b then text "cc\t" else char '\t',
pprReg reg1,
comma,
@@ -638,11 +631,11 @@ pprRegRIReg platform name b reg1 ri reg2
]
{-
-pprRIReg :: PtrString -> Bool -> RI -> Reg -> SDoc
+pprRIReg :: SDoc -> Bool -> RI -> Reg -> SDoc
pprRIReg name b ri reg1
= hcat [
char '\t',
- ptext name,
+ name,
if b then text "cc\t" else char '\t',
pprRI ri,
comma,
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 7b803b2708..97dcda5a5b 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -2465,7 +2465,7 @@ genCCall' config is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
genCCall' config is32Bit target dest_regs args bid
where
format = intFormat width
- lbl = mkCmmCodeLabel primUnitId (fsLit (popCntLabel width))
+ lbl = mkCmmCodeLabel primUnitId (popCntLabel width)
genCCall' config is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst]
args@[src, mask] bid = do
@@ -2498,7 +2498,7 @@ genCCall' config is32Bit (PrimTarget (MO_Pdep width)) dest_regs@[dst]
genCCall' config is32Bit target dest_regs args bid
where
format = intFormat width
- lbl = mkCmmCodeLabel primUnitId (fsLit (pdepLabel width))
+ lbl = mkCmmCodeLabel primUnitId (pdepLabel width)
genCCall' config is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst]
args@[src, mask] bid = do
@@ -2531,7 +2531,7 @@ genCCall' config is32Bit (PrimTarget (MO_Pext width)) dest_regs@[dst]
genCCall' config is32Bit target dest_regs args bid
where
format = intFormat width
- lbl = mkCmmCodeLabel primUnitId (fsLit (pextLabel width))
+ lbl = mkCmmCodeLabel primUnitId (pextLabel width)
genCCall' config is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bid
| is32Bit && width == W64 = do
@@ -2576,7 +2576,7 @@ genCCall' config is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src]
-- took care of implicitly clearing the upper bits
where
bw = widthInBits width
- lbl = mkCmmCodeLabel primUnitId (fsLit (clzLabel width))
+ lbl = mkCmmCodeLabel primUnitId (clzLabel width)
genCCall' config is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do
targetExpr <- cmmMakeDynamicReference config
@@ -2586,7 +2586,7 @@ genCCall' config is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do
CmmMayReturn)
genCCall' config is32Bit target dest_regs args bid
where
- lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width))
+ lbl = mkCmmCodeLabel primUnitId (word2FloatLabel width)
genCCall' _ _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] _ = do
load_code <- intLoadCode (MOV (intFormat width)) addr
@@ -3401,12 +3401,12 @@ outOfLineCmmOp bid mop res args
{- Here the C implementation is used as there is no x86
instruction to reverse a word's bit order.
-}
- MO_BRev w -> fsLit $ bRevLabel w
- MO_Clz w -> fsLit $ clzLabel w
+ MO_BRev w -> bRevLabel w
+ MO_Clz w -> clzLabel w
MO_Ctz _ -> unsupported
- MO_Pdep w -> fsLit $ pdepLabel w
- MO_Pext w -> fsLit $ pextLabel w
+ MO_Pdep w -> pdepLabel w
+ MO_Pext w -> pextLabel w
MO_AtomicRMW _ _ -> fsLit "atomicrmw"
MO_AtomicRead _ -> fsLit "atomicread"
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 2d12e90443..a03a0bd82f 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -45,7 +45,6 @@ import GHC.Cmm.CLabel
import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
import GHC.Types.Unique ( pprUniqueAlways )
-import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -100,7 +99,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
pprProcAlignment config $$
pprProcLabel config lbl $$
(if platformHasSubsectionsViaSymbols platform
- then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
+ then pdoc platform (mkDeadStripPreventer info_lbl) <> colon
else empty) $$
vcat (map (pprBasicBlock config top_info) blocks) $$
ppWhen (ncgDwarfEnabled config) (pprProcEndLabel platform info_lbl) $$
@@ -120,25 +119,25 @@ pprProcLabel :: NCGConfig -> CLabel -> SDoc
pprProcLabel config lbl
| ncgExposeInternalSymbols config
, Just lbl' <- ppInternalProcLabel (ncgThisModule config) lbl
- = lbl' <> char ':'
+ = lbl' <> colon
| otherwise
= empty
pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
-> SDoc
pprProcEndLabel platform lbl =
- pdoc platform (mkAsmTempProcEndLabel lbl) <> char ':'
+ pdoc platform (mkAsmTempProcEndLabel lbl) <> colon
pprBlockEndLabel :: Platform -> CLabel -- ^ Block name
-> SDoc
pprBlockEndLabel platform lbl =
- pdoc platform (mkAsmTempEndLabel lbl) <> char ':'
+ pdoc platform (mkAsmTempEndLabel lbl) <> colon
-- | Output the ELF .size directive.
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl platform lbl
= if osElfTarget (platformOS platform)
- then text "\t.size" <+> pdoc platform lbl <> ptext (sLit ", .-") <> pdoc platform lbl
+ then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl
else empty
pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc
@@ -163,7 +162,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
vcat (map (pprData config) info) $$
pprLabel platform infoLbl $$
c $$
- ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel infoLbl) <> char ':')
+ ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel infoLbl) <> colon)
-- Make sure the info table has the right .loc for the block
-- coming right after it. See [Note: Info Offset]
@@ -267,14 +266,14 @@ pprLabelType' platform lbl =
pprTypeDecl :: Platform -> CLabel -> SDoc
pprTypeDecl platform lbl
= if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
- then text ".type " <> pdoc platform lbl <> ptext (sLit ", ") <> pprLabelType' platform lbl
+ then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl
else empty
pprLabel :: Platform -> CLabel -> SDoc
pprLabel platform lbl =
pprGloblDecl platform lbl
$$ pprTypeDecl platform lbl
- $$ (pdoc platform lbl <> char ':')
+ $$ (pdoc platform lbl <> colon)
pprAlign :: Platform -> Alignment -> SDoc
pprAlign platform alignment
@@ -310,30 +309,30 @@ pprReg platform f r
ppr32_reg_no II16 = ppr32_reg_word
ppr32_reg_no _ = ppr32_reg_long
- ppr32_reg_byte i = ptext
- (case i of {
- 0 -> sLit "%al"; 1 -> sLit "%bl";
- 2 -> sLit "%cl"; 3 -> sLit "%dl";
- _ -> sLit $ "very naughty I386 byte register: " ++ show i
- })
-
- ppr32_reg_word i = ptext
- (case i of {
- 0 -> sLit "%ax"; 1 -> sLit "%bx";
- 2 -> sLit "%cx"; 3 -> sLit "%dx";
- 4 -> sLit "%si"; 5 -> sLit "%di";
- 6 -> sLit "%bp"; 7 -> sLit "%sp";
- _ -> sLit "very naughty I386 word register"
- })
-
- ppr32_reg_long i = ptext
- (case i of {
- 0 -> sLit "%eax"; 1 -> sLit "%ebx";
- 2 -> sLit "%ecx"; 3 -> sLit "%edx";
- 4 -> sLit "%esi"; 5 -> sLit "%edi";
- 6 -> sLit "%ebp"; 7 -> sLit "%esp";
+ ppr32_reg_byte i =
+ case i of {
+ 0 -> text "%al"; 1 -> text "%bl";
+ 2 -> text "%cl"; 3 -> text "%dl";
+ _ -> text "very naughty I386 byte register: " <> int i
+ }
+
+ ppr32_reg_word i =
+ case i of {
+ 0 -> text "%ax"; 1 -> text "%bx";
+ 2 -> text "%cx"; 3 -> text "%dx";
+ 4 -> text "%si"; 5 -> text "%di";
+ 6 -> text "%bp"; 7 -> text "%sp";
+ _ -> text "very naughty I386 word register"
+ }
+
+ ppr32_reg_long i =
+ case i of {
+ 0 -> text "%eax"; 1 -> text "%ebx";
+ 2 -> text "%ecx"; 3 -> text "%edx";
+ 4 -> text "%esi"; 5 -> text "%edi";
+ 6 -> text "%ebp"; 7 -> text "%esp";
_ -> ppr_reg_float i
- })
+ }
ppr64_reg_no :: Format -> Int -> SDoc
ppr64_reg_no II8 = ppr64_reg_byte
@@ -341,101 +340,97 @@ pprReg platform f r
ppr64_reg_no II32 = ppr64_reg_long
ppr64_reg_no _ = ppr64_reg_quad
- ppr64_reg_byte i = ptext
- (case i of {
- 0 -> sLit "%al"; 1 -> sLit "%bl";
- 2 -> sLit "%cl"; 3 -> sLit "%dl";
- 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
- 6 -> sLit "%bpl"; 7 -> sLit "%spl";
- 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
- 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
- 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
- 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
- _ -> sLit $ "very naughty x86_64 byte register: " ++ show i
- })
-
- ppr64_reg_word i = ptext
- (case i of {
- 0 -> sLit "%ax"; 1 -> sLit "%bx";
- 2 -> sLit "%cx"; 3 -> sLit "%dx";
- 4 -> sLit "%si"; 5 -> sLit "%di";
- 6 -> sLit "%bp"; 7 -> sLit "%sp";
- 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
- 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
- 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
- 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
- _ -> sLit "very naughty x86_64 word register"
- })
-
- ppr64_reg_long i = ptext
- (case i of {
- 0 -> sLit "%eax"; 1 -> sLit "%ebx";
- 2 -> sLit "%ecx"; 3 -> sLit "%edx";
- 4 -> sLit "%esi"; 5 -> sLit "%edi";
- 6 -> sLit "%ebp"; 7 -> sLit "%esp";
- 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
- 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
- 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
- 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
- _ -> sLit "very naughty x86_64 register"
- })
-
- ppr64_reg_quad i = ptext
- (case i of {
- 0 -> sLit "%rax"; 1 -> sLit "%rbx";
- 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
- 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
- 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
- 8 -> sLit "%r8"; 9 -> sLit "%r9";
- 10 -> sLit "%r10"; 11 -> sLit "%r11";
- 12 -> sLit "%r12"; 13 -> sLit "%r13";
- 14 -> sLit "%r14"; 15 -> sLit "%r15";
+ ppr64_reg_byte i =
+ case i of {
+ 0 -> text "%al"; 1 -> text "%bl";
+ 2 -> text "%cl"; 3 -> text "%dl";
+ 4 -> text "%sil"; 5 -> text "%dil"; -- new 8-bit regs!
+ 6 -> text "%bpl"; 7 -> text "%spl";
+ 8 -> text "%r8b"; 9 -> text "%r9b";
+ 10 -> text "%r10b"; 11 -> text "%r11b";
+ 12 -> text "%r12b"; 13 -> text "%r13b";
+ 14 -> text "%r14b"; 15 -> text "%r15b";
+ _ -> text "very naughty x86_64 byte register: " <> int i
+ }
+
+ ppr64_reg_word i =
+ case i of {
+ 0 -> text "%ax"; 1 -> text "%bx";
+ 2 -> text "%cx"; 3 -> text "%dx";
+ 4 -> text "%si"; 5 -> text "%di";
+ 6 -> text "%bp"; 7 -> text "%sp";
+ 8 -> text "%r8w"; 9 -> text "%r9w";
+ 10 -> text "%r10w"; 11 -> text "%r11w";
+ 12 -> text "%r12w"; 13 -> text "%r13w";
+ 14 -> text "%r14w"; 15 -> text "%r15w";
+ _ -> text "very naughty x86_64 word register"
+ }
+
+ ppr64_reg_long i =
+ case i of {
+ 0 -> text "%eax"; 1 -> text "%ebx";
+ 2 -> text "%ecx"; 3 -> text "%edx";
+ 4 -> text "%esi"; 5 -> text "%edi";
+ 6 -> text "%ebp"; 7 -> text "%esp";
+ 8 -> text "%r8d"; 9 -> text "%r9d";
+ 10 -> text "%r10d"; 11 -> text "%r11d";
+ 12 -> text "%r12d"; 13 -> text "%r13d";
+ 14 -> text "%r14d"; 15 -> text "%r15d";
+ _ -> text "very naughty x86_64 register"
+ }
+
+ ppr64_reg_quad i =
+ case i of {
+ 0 -> text "%rax"; 1 -> text "%rbx";
+ 2 -> text "%rcx"; 3 -> text "%rdx";
+ 4 -> text "%rsi"; 5 -> text "%rdi";
+ 6 -> text "%rbp"; 7 -> text "%rsp";
+ 8 -> text "%r8"; 9 -> text "%r9";
+ 10 -> text "%r10"; 11 -> text "%r11";
+ 12 -> text "%r12"; 13 -> text "%r13";
+ 14 -> text "%r14"; 15 -> text "%r15";
_ -> ppr_reg_float i
- })
+ }
-ppr_reg_float :: Int -> PtrString
+ppr_reg_float :: Int -> SDoc
ppr_reg_float i = case i of
- 16 -> sLit "%xmm0" ; 17 -> sLit "%xmm1"
- 18 -> sLit "%xmm2" ; 19 -> sLit "%xmm3"
- 20 -> sLit "%xmm4" ; 21 -> sLit "%xmm5"
- 22 -> sLit "%xmm6" ; 23 -> sLit "%xmm7"
- 24 -> sLit "%xmm8" ; 25 -> sLit "%xmm9"
- 26 -> sLit "%xmm10"; 27 -> sLit "%xmm11"
- 28 -> sLit "%xmm12"; 29 -> sLit "%xmm13"
- 30 -> sLit "%xmm14"; 31 -> sLit "%xmm15"
- _ -> sLit "very naughty x86 register"
+ 16 -> text "%xmm0" ; 17 -> text "%xmm1"
+ 18 -> text "%xmm2" ; 19 -> text "%xmm3"
+ 20 -> text "%xmm4" ; 21 -> text "%xmm5"
+ 22 -> text "%xmm6" ; 23 -> text "%xmm7"
+ 24 -> text "%xmm8" ; 25 -> text "%xmm9"
+ 26 -> text "%xmm10"; 27 -> text "%xmm11"
+ 28 -> text "%xmm12"; 29 -> text "%xmm13"
+ 30 -> text "%xmm14"; 31 -> text "%xmm15"
+ _ -> text "very naughty x86 register"
pprFormat :: Format -> SDoc
-pprFormat x
- = ptext (case x of
- II8 -> sLit "b"
- II16 -> sLit "w"
- II32 -> sLit "l"
- II64 -> sLit "q"
- FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
- FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
- )
+pprFormat x = case x of
+ II8 -> text "b"
+ II16 -> text "w"
+ II32 -> text "l"
+ II64 -> text "q"
+ FF32 -> text "ss" -- "scalar single-precision float" (SSE2)
+ FF64 -> text "sd" -- "scalar double-precision float" (SSE2)
pprFormat_x87 :: Format -> SDoc
-pprFormat_x87 x
- = ptext $ case x of
- FF32 -> sLit "s"
- FF64 -> sLit "l"
- _ -> panic "X86.Ppr.pprFormat_x87"
+pprFormat_x87 x = case x of
+ FF32 -> text "s"
+ FF64 -> text "l"
+ _ -> panic "X86.Ppr.pprFormat_x87"
pprCond :: Cond -> SDoc
-pprCond c
- = ptext (case c of {
- GEU -> sLit "ae"; LU -> sLit "b";
- EQQ -> sLit "e"; GTT -> sLit "g";
- GE -> sLit "ge"; GU -> sLit "a";
- LTT -> sLit "l"; LE -> sLit "le";
- LEU -> sLit "be"; NE -> sLit "ne";
- NEG -> sLit "s"; POS -> sLit "ns";
- CARRY -> sLit "c"; OFLO -> sLit "o";
- PARITY -> sLit "p"; NOTPARITY -> sLit "np";
- ALWAYS -> sLit "mp"})
+pprCond c = case c of {
+ GEU -> text "ae"; LU -> text "b";
+ EQQ -> text "e"; GTT -> text "g";
+ GE -> text "ge"; GU -> text "a";
+ LTT -> text "l"; LE -> text "le";
+ LEU -> text "be"; NE -> text "ne";
+ NEG -> text "s"; POS -> text "ns";
+ CARRY -> text "c"; OFLO -> text "o";
+ PARITY -> text "p"; NOTPARITY -> text "np";
+ ALWAYS -> text "mp"}
pprImm :: Platform -> Imm -> SDoc
@@ -624,70 +619,70 @@ pprInstr platform i = case i of
_ -> format
MOV format src dst
- -> pprFormatOpOp (sLit "mov") format src dst
+ -> pprFormatOpOp (text "mov") format src dst
CMOV cc format src dst
- -> pprCondOpReg (sLit "cmov") format cc src dst
+ -> pprCondOpReg (text "cmov") format cc src dst
MOVZxL II32 src dst
- -> pprFormatOpOp (sLit "mov") II32 src dst
+ -> pprFormatOpOp (text "mov") II32 src dst
-- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
-- movl. But we represent it as a MOVZxL instruction, because
-- the reg alloc would tend to throw away a plain reg-to-reg
-- move, and we still want it to do that.
MOVZxL formats src dst
- -> pprFormatOpOpCoerce (sLit "movz") formats II32 src dst
+ -> pprFormatOpOpCoerce (text "movz") formats II32 src dst
-- zero-extension only needs to extend to 32 bits: on x86_64,
-- the remaining zero-extension to 64 bits is automatic, and the 32-bit
-- instruction is shorter.
MOVSxL formats src dst
- -> pprFormatOpOpCoerce (sLit "movs") formats (archWordFormat (target32Bit platform)) src dst
+ -> pprFormatOpOpCoerce (text "movs") formats (archWordFormat (target32Bit platform)) src dst
-- here we do some patching, since the physical registers are only set late
-- in the code generation.
LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)
| reg1 == reg3
- -> pprFormatOpOp (sLit "add") format (OpReg reg2) dst
+ -> pprFormatOpOp (text "add") format (OpReg reg2) dst
LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)
| reg2 == reg3
- -> pprFormatOpOp (sLit "add") format (OpReg reg1) dst
+ -> pprFormatOpOp (text "add") format (OpReg reg1) dst
LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3)
| reg1 == reg3
-> pprInstr platform (ADD format (OpImm displ) dst)
LEA format src dst
- -> pprFormatOpOp (sLit "lea") format src dst
+ -> pprFormatOpOp (text "lea") format src dst
ADD format (OpImm (ImmInt (-1))) dst
- -> pprFormatOp (sLit "dec") format dst
+ -> pprFormatOp (text "dec") format dst
ADD format (OpImm (ImmInt 1)) dst
- -> pprFormatOp (sLit "inc") format dst
+ -> pprFormatOp (text "inc") format dst
ADD format src dst
- -> pprFormatOpOp (sLit "add") format src dst
+ -> pprFormatOpOp (text "add") format src dst
ADC format src dst
- -> pprFormatOpOp (sLit "adc") format src dst
+ -> pprFormatOpOp (text "adc") format src dst
SUB format src dst
- -> pprFormatOpOp (sLit "sub") format src dst
+ -> pprFormatOpOp (text "sub") format src dst
SBB format src dst
- -> pprFormatOpOp (sLit "sbb") format src dst
+ -> pprFormatOpOp (text "sbb") format src dst
IMUL format op1 op2
- -> pprFormatOpOp (sLit "imul") format op1 op2
+ -> pprFormatOpOp (text "imul") format op1 op2
ADD_CC format src dst
- -> pprFormatOpOp (sLit "add") format src dst
+ -> pprFormatOpOp (text "add") format src dst
SUB_CC format src dst
- -> pprFormatOpOp (sLit "sub") format src dst
+ -> pprFormatOpOp (text "sub") format src dst
-- Use a 32-bit instruction when possible as it saves a byte.
-- Notably, extracting the tag bits of a pointer has this form.
@@ -698,86 +693,86 @@ pprInstr platform i = case i of
-> pprInstr platform (AND II32 src dst)
AND FF32 src dst
- -> pprOpOp (sLit "andps") FF32 src dst
+ -> pprOpOp (text "andps") FF32 src dst
AND FF64 src dst
- -> pprOpOp (sLit "andpd") FF64 src dst
+ -> pprOpOp (text "andpd") FF64 src dst
AND format src dst
- -> pprFormatOpOp (sLit "and") format src dst
+ -> pprFormatOpOp (text "and") format src dst
OR format src dst
- -> pprFormatOpOp (sLit "or") format src dst
+ -> pprFormatOpOp (text "or") format src dst
XOR FF32 src dst
- -> pprOpOp (sLit "xorps") FF32 src dst
+ -> pprOpOp (text "xorps") FF32 src dst
XOR FF64 src dst
- -> pprOpOp (sLit "xorpd") FF64 src dst
+ -> pprOpOp (text "xorpd") FF64 src dst
XOR format src dst
- -> pprFormatOpOp (sLit "xor") format src dst
+ -> pprFormatOpOp (text "xor") format src dst
POPCNT format src dst
- -> pprOpOp (sLit "popcnt") format src (OpReg dst)
+ -> pprOpOp (text "popcnt") format src (OpReg dst)
LZCNT format src dst
- -> pprOpOp (sLit "lzcnt") format src (OpReg dst)
+ -> pprOpOp (text "lzcnt") format src (OpReg dst)
TZCNT format src dst
- -> pprOpOp (sLit "tzcnt") format src (OpReg dst)
+ -> pprOpOp (text "tzcnt") format src (OpReg dst)
BSF format src dst
- -> pprOpOp (sLit "bsf") format src (OpReg dst)
+ -> pprOpOp (text "bsf") format src (OpReg dst)
BSR format src dst
- -> pprOpOp (sLit "bsr") format src (OpReg dst)
+ -> pprOpOp (text "bsr") format src (OpReg dst)
PDEP format src mask dst
- -> pprFormatOpOpReg (sLit "pdep") format src mask dst
+ -> pprFormatOpOpReg (text "pdep") format src mask dst
PEXT format src mask dst
- -> pprFormatOpOpReg (sLit "pext") format src mask dst
+ -> pprFormatOpOpReg (text "pext") format src mask dst
PREFETCH NTA format src
- -> pprFormatOp_ (sLit "prefetchnta") format src
+ -> pprFormatOp_ (text "prefetchnta") format src
PREFETCH Lvl0 format src
- -> pprFormatOp_ (sLit "prefetcht0") format src
+ -> pprFormatOp_ (text "prefetcht0") format src
PREFETCH Lvl1 format src
- -> pprFormatOp_ (sLit "prefetcht1") format src
+ -> pprFormatOp_ (text "prefetcht1") format src
PREFETCH Lvl2 format src
- -> pprFormatOp_ (sLit "prefetcht2") format src
+ -> pprFormatOp_ (text "prefetcht2") format src
NOT format op
- -> pprFormatOp (sLit "not") format op
+ -> pprFormatOp (text "not") format op
BSWAP format op
- -> pprFormatOp (sLit "bswap") format (OpReg op)
+ -> pprFormatOp (text "bswap") format (OpReg op)
NEGI format op
- -> pprFormatOp (sLit "neg") format op
+ -> pprFormatOp (text "neg") format op
SHL format src dst
- -> pprShift (sLit "shl") format src dst
+ -> pprShift (text "shl") format src dst
SAR format src dst
- -> pprShift (sLit "sar") format src dst
+ -> pprShift (text "sar") format src dst
SHR format src dst
- -> pprShift (sLit "shr") format src dst
+ -> pprShift (text "shr") format src dst
BT format imm src
- -> pprFormatImmOp (sLit "bt") format imm src
+ -> pprFormatImmOp (text "bt") format imm src
CMP format src dst
- | isFloatFormat format -> pprFormatOpOp (sLit "ucomi") format src dst -- SSE2
- | otherwise -> pprFormatOpOp (sLit "cmp") format src dst
+ | isFloatFormat format -> pprFormatOpOp (text "ucomi") format src dst -- SSE2
+ | otherwise -> pprFormatOpOp (text "cmp") format src dst
TEST format src dst
- -> pprFormatOpOp (sLit "test") format' src dst
+ -> pprFormatOpOp (text "test") format' src dst
where
-- Match instructions like 'test $0x3,%esi' or 'test $0x7,%rbx'.
-- We can replace them by equivalent, but smaller instructions
@@ -800,10 +795,10 @@ pprInstr platform i = case i of
minSizeOfReg _ _ = format -- other
PUSH format op
- -> pprFormatOp (sLit "push") format op
+ -> pprFormatOp (text "push") format op
POP format op
- -> pprFormatOp (sLit "pop") format op
+ -> pprFormatOp (text "pop") format op
-- both unused (SDM):
-- PUSHA -> text "\tpushal"
@@ -828,17 +823,17 @@ pprInstr platform i = case i of
-> panic $ "pprInstr: CLTD " ++ show x
SETCC cond op
- -> pprCondInstr (sLit "set") cond (pprOperand platform II8 op)
+ -> pprCondInstr (text "set") cond (pprOperand platform II8 op)
XCHG format src val
- -> pprFormatOpReg (sLit "xchg") format src val
+ -> pprFormatOpReg (text "xchg") format src val
JXX cond blockid
- -> pprCondInstr (sLit "j") cond (pdoc platform lab)
+ -> pprCondInstr (text "j") cond (pdoc platform lab)
where lab = blockLbl blockid
JXX_GBL cond imm
- -> pprCondInstr (sLit "j") cond (pprImm platform imm)
+ -> pprCondInstr (text "j") cond (pprImm platform imm)
JMP (OpImm imm) _
-> text "\tjmp " <> pprImm platform imm
@@ -856,44 +851,44 @@ pprInstr platform i = case i of
-> text "\tcall *" <> pprReg platform (archWordFormat (target32Bit platform)) reg
IDIV fmt op
- -> pprFormatOp (sLit "idiv") fmt op
+ -> pprFormatOp (text "idiv") fmt op
DIV fmt op
- -> pprFormatOp (sLit "div") fmt op
+ -> pprFormatOp (text "div") fmt op
IMUL2 fmt op
- -> pprFormatOp (sLit "imul") fmt op
+ -> pprFormatOp (text "imul") fmt op
-- x86_64 only
MUL format op1 op2
- -> pprFormatOpOp (sLit "mul") format op1 op2
+ -> pprFormatOpOp (text "mul") format op1 op2
MUL2 format op
- -> pprFormatOp (sLit "mul") format op
+ -> pprFormatOp (text "mul") format op
FDIV format op1 op2
- -> pprFormatOpOp (sLit "div") format op1 op2
+ -> pprFormatOpOp (text "div") format op1 op2
SQRT format op1 op2
- -> pprFormatOpReg (sLit "sqrt") format op1 op2
+ -> pprFormatOpReg (text "sqrt") format op1 op2
CVTSS2SD from to
- -> pprRegReg (sLit "cvtss2sd") from to
+ -> pprRegReg (text "cvtss2sd") from to
CVTSD2SS from to
- -> pprRegReg (sLit "cvtsd2ss") from to
+ -> pprRegReg (text "cvtsd2ss") from to
CVTTSS2SIQ fmt from to
- -> pprFormatFormatOpReg (sLit "cvttss2si") FF32 fmt from to
+ -> pprFormatFormatOpReg (text "cvttss2si") FF32 fmt from to
CVTTSD2SIQ fmt from to
- -> pprFormatFormatOpReg (sLit "cvttsd2si") FF64 fmt from to
+ -> pprFormatFormatOpReg (text "cvttsd2si") FF64 fmt from to
CVTSI2SS fmt from to
- -> pprFormatOpReg (sLit "cvtsi2ss") fmt from to
+ -> pprFormatOpReg (text "cvtsi2ss") fmt from to
CVTSI2SD fmt from to
- -> pprFormatOpReg (sLit "cvtsi2sd") fmt from to
+ -> pprFormatOpReg (text "cvtsi2sd") fmt from to
-- FETCHGOT for PIC on ELF platforms
FETCHGOT reg
@@ -925,10 +920,10 @@ pprInstr platform i = case i of
-> text "\tmfence"
XADD format src dst
- -> pprFormatOpOp (sLit "xadd") format src dst
+ -> pprFormatOpOp (text "xadd") format src dst
CMPXCHG format src dst
- -> pprFormatOpOp (sLit "cmpxchg") format src dst
+ -> pprFormatOpOp (text "cmpxchg") format src dst
where
@@ -945,7 +940,7 @@ pprInstr platform i = case i of
= (char '#' <> pprX87Instr fake) $$ actual
pprX87Instr :: Instr -> SDoc
- pprX87Instr (X87Store fmt dst) = pprFormatAddr (sLit "gst") fmt dst
+ pprX87Instr (X87Store fmt dst) = pprFormatAddr (text "gst") fmt dst
pprX87Instr _ = panic "X86.Ppr.pprX87Instr: no match"
pprDollImm :: Imm -> SDoc
@@ -959,17 +954,17 @@ pprInstr platform i = case i of
OpAddr ea -> pprAddr platform ea
- pprMnemonic_ :: PtrString -> SDoc
+ pprMnemonic_ :: SDoc -> SDoc
pprMnemonic_ name =
- char '\t' <> ptext name <> space
+ char '\t' <> name <> space
- pprMnemonic :: PtrString -> Format -> SDoc
+ pprMnemonic :: SDoc -> Format -> SDoc
pprMnemonic name format =
- char '\t' <> ptext name <> pprFormat format <> space
+ char '\t' <> name <> pprFormat format <> space
- pprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc
+ pprFormatImmOp :: SDoc -> Format -> Imm -> Operand -> SDoc
pprFormatImmOp name format imm op1
= hcat [
pprMnemonic name format,
@@ -980,14 +975,14 @@ pprInstr platform i = case i of
]
- pprFormatOp_ :: PtrString -> Format -> Operand -> SDoc
+ pprFormatOp_ :: SDoc -> Format -> Operand -> SDoc
pprFormatOp_ name format op1
= hcat [
pprMnemonic_ name ,
pprOperand platform format op1
]
- pprFormatOp :: PtrString -> Format -> Operand -> SDoc
+ pprFormatOp :: SDoc -> Format -> Operand -> SDoc
pprFormatOp name format op1
= hcat [
pprMnemonic name format,
@@ -995,7 +990,7 @@ pprInstr platform i = case i of
]
- pprFormatOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
+ pprFormatOpOp :: SDoc -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp name format op1 op2
= hcat [
pprMnemonic name format,
@@ -1005,7 +1000,7 @@ pprInstr platform i = case i of
]
- pprOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
+ pprOpOp :: SDoc -> Format -> Operand -> Operand -> SDoc
pprOpOp name format op1 op2
= hcat [
pprMnemonic_ name,
@@ -1014,7 +1009,7 @@ pprInstr platform i = case i of
pprOperand platform format op2
]
- pprRegReg :: PtrString -> Reg -> Reg -> SDoc
+ pprRegReg :: SDoc -> Reg -> Reg -> SDoc
pprRegReg name reg1 reg2
= hcat [
pprMnemonic_ name,
@@ -1024,7 +1019,7 @@ pprInstr platform i = case i of
]
- pprFormatOpReg :: PtrString -> Format -> Operand -> Reg -> SDoc
+ pprFormatOpReg :: SDoc -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg name format op1 reg2
= hcat [
pprMnemonic name format,
@@ -1033,11 +1028,11 @@ pprInstr platform i = case i of
pprReg platform (archWordFormat (target32Bit platform)) reg2
]
- pprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
+ pprCondOpReg :: SDoc -> Format -> Cond -> Operand -> Reg -> SDoc
pprCondOpReg name format cond op1 reg2
= hcat [
char '\t',
- ptext name,
+ name,
pprCond cond,
space,
pprOperand platform format op1,
@@ -1045,7 +1040,7 @@ pprInstr platform i = case i of
pprReg platform format reg2
]
- pprFormatFormatOpReg :: PtrString -> Format -> Format -> Operand -> Reg -> SDoc
+ pprFormatFormatOpReg :: SDoc -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg name format1 format2 op1 reg2
= hcat [
pprMnemonic name format2,
@@ -1054,7 +1049,7 @@ pprInstr platform i = case i of
pprReg platform format2 reg2
]
- pprFormatOpOpReg :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
+ pprFormatOpOpReg :: SDoc -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg name format op1 op2 reg3
= hcat [
pprMnemonic name format,
@@ -1067,7 +1062,7 @@ pprInstr platform i = case i of
- pprFormatAddr :: PtrString -> Format -> AddrMode -> SDoc
+ pprFormatAddr :: SDoc -> Format -> AddrMode -> SDoc
pprFormatAddr name format op
= hcat [
pprMnemonic name format,
@@ -1075,7 +1070,7 @@ pprInstr platform i = case i of
pprAddr platform op
]
- pprShift :: PtrString -> Format -> Operand -> Operand -> SDoc
+ pprShift :: SDoc -> Format -> Operand -> Operand -> SDoc
pprShift name format src dest
= hcat [
pprMnemonic name format,
@@ -1085,15 +1080,15 @@ pprInstr platform i = case i of
]
- pprFormatOpOpCoerce :: PtrString -> Format -> Format -> Operand -> Operand -> SDoc
+ pprFormatOpOpCoerce :: SDoc -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce name format1 format2 op1 op2
- = hcat [ char '\t', ptext name, pprFormat format1, pprFormat format2, space,
+ = hcat [ char '\t', name, pprFormat format1, pprFormat format2, space,
pprOperand platform format1 op1,
comma,
pprOperand platform format2 op2
]
- pprCondInstr :: PtrString -> Cond -> SDoc -> SDoc
+ pprCondInstr :: SDoc -> Cond -> SDoc -> SDoc
pprCondInstr name cond arg
- = hcat [ char '\t', ptext name, pprCond cond, space, arg]
+ = hcat [ char '\t', name, pprCond cond, space, arg]
View Lorry Controller Status