Skip to content

GitLab

Commit a12b6bf8 authored by Ian Lynagh's avatar Ian Lynagh
Browse files
Options

Use SDoc rather than Doc in the native gens 

This avoid lots of converting back and forth between the two types.
parent ffa6d17c
Hide whitespace changes
Inline Side-by-side
Showing with 236 additions and 279 deletions
compiler/nativeGen/AsmCodeGen.lhs
View file @ a12b6bf8
......@@ -64,7 +64,6 @@ import Util
import BasicTypes ( Alignment )
import Digraph
import Pretty (Doc)
import qualified Pretty
import BufWrite
import Outputable
......@@ -114,7 +113,7 @@ The machine-dependent bits break down as follows:
machine instructions.
* ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
a 'Doc').
a 'SDoc').
* ["RegAllocInfo"] In the register allocator, we manipulate
'MRegsState's, which are 'BitSet's, one bit per machine register.
......@@ -139,7 +138,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
canShortcut :: instr -> Maybe jumpDest,
shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics,
shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr,
pprNatCmmDecl :: Platform -> NatCmmDecl statics instr -> Doc,
pprNatCmmDecl :: Platform -> NatCmmDecl statics instr -> SDoc,
maxSpillSlots :: Int,
allocatableRegs :: [RealReg],
ncg_x86fp_kludge :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
......@@ -228,7 +227,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
-- dump native code
dumpIfSet_dyn dflags
Opt_D_dump_asm "Asm code"
(vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) $ concat native)
(vcat $ map (pprNatCmmDecl ncgImpl platform) $ concat native)
-- dump global NCG stats for graph coloring allocator
(case concat $ catMaybes colorStats of
......@@ -261,6 +260,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
-- write out the imports
Pretty.printDoc Pretty.LeftMode h
$ withPprStyleDoc (mkCodeStyle AsmStyle)
$ makeImportsDoc dflags (concat imports)
return ()
......@@ -301,7 +301,8 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count
<- {-# SCC "cmmNativeGen" #-} cmmNativeGen dflags ncgImpl us cmm count
{-# SCC "pprNativeCode" #-} Pretty.bufLeftRender h
$ Pretty.vcat $ map (pprNatCmmDecl ncgImpl platform) native
$ withPprStyleDoc (mkCodeStyle AsmStyle)
$ vcat $ map (pprNatCmmDecl ncgImpl platform) native
-- carefully evaluate this strictly. Binding it with 'let'
-- and then using 'seq' doesn't work, because the let
......@@ -368,7 +369,7 @@ cmmNativeGen dflags ncgImpl us cmm count
dumpIfSet_dyn dflags
Opt_D_dump_asm_native "Native code"
(vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) native)
(vcat $ map (pprNatCmmDecl ncgImpl platform) native)
-- tag instructions with register liveness information
let (withLiveness, usLive) =
......@@ -406,7 +407,7 @@ cmmNativeGen dflags ncgImpl us cmm count
-- dump out what happened during register allocation
dumpIfSet_dyn dflags
Opt_D_dump_asm_regalloc "Registers allocated"
(vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) alloced)
(vcat $ map (pprNatCmmDecl ncgImpl platform) alloced)
dumpIfSet_dyn dflags
Opt_D_dump_asm_regalloc_stages "Build/spill stages"
......@@ -437,7 +438,7 @@ cmmNativeGen dflags ncgImpl us cmm count
dumpIfSet_dyn dflags
Opt_D_dump_asm_regalloc "Registers allocated"
(vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) alloced)
(vcat $ map (pprNatCmmDecl ncgImpl platform) alloced)
let mPprStats =
if dopt Opt_D_dump_asm_stats dflags
......@@ -481,7 +482,7 @@ cmmNativeGen dflags ncgImpl us cmm count
dumpIfSet_dyn dflags
Opt_D_dump_asm_expanded "Synthetic instructions expanded"
(vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) expanded)
(vcat $ map (pprNatCmmDecl ncgImpl platform) expanded)
return ( usAlloc
, expanded
......@@ -498,17 +499,17 @@ x86fp_kludge (CmmProc info lbl (ListGraph code)) =
-- | Build a doc for all the imports.
--
makeImportsDoc :: DynFlags -> [CLabel] -> Pretty.Doc
makeImportsDoc :: DynFlags -> [CLabel] -> SDoc
makeImportsDoc dflags imports
= dyld_stubs imports
Pretty.$$
$$
-- On recent versions of Darwin, the linker supports
-- dead-stripping of code and data on a per-symbol basis.
-- There's a hack to make this work in PprMach.pprNatCmmDecl.
(if platformHasSubsectionsViaSymbols (targetPlatform dflags)
then Pretty.text ".subsections_via_symbols"
else Pretty.empty)
Pretty.$$
then text ".subsections_via_symbols"
else empty)
$$
-- On recent GNU ELF systems one can mark an object file
-- as not requiring an executable stack. If all objects
-- linked into a program have this note then the program
......@@ -516,23 +517,21 @@ makeImportsDoc dflags imports
-- security. GHC generated code does not need an executable
-- stack so add the note in:
(if platformHasGnuNonexecStack (targetPlatform dflags)
then Pretty.text ".section .note.GNU-stack,\"\",@progbits"
else Pretty.empty)
Pretty.$$
then text ".section .note.GNU-stack,\"\",@progbits"
else empty)
$$
-- And just because every other compiler does, lets stick in
-- an identifier directive: .ident "GHC x.y.z"
(if platformHasIdentDirective (targetPlatform dflags)
then let compilerIdent = Pretty.text "GHC" Pretty.<+>
Pretty.text cProjectVersion
in Pretty.text ".ident" Pretty.<+>
Pretty.doubleQuotes compilerIdent
else Pretty.empty)
then let compilerIdent = text "GHC" <+> text cProjectVersion
in text ".ident" <+> doubleQuotes compilerIdent
else empty)
where
-- Generate "symbol stubs" for all external symbols that might
-- come from a dynamic library.
dyld_stubs :: [CLabel] -> Pretty.Doc
{- dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
dyld_stubs :: [CLabel] -> SDoc
{- dyld_stubs imps = vcat $ map pprDyldSymbolStub $
map head $ group $ sort imps-}
platform = targetPlatform dflags
......@@ -543,7 +542,7 @@ makeImportsDoc dflags imports
-- different uniques; so we compare their text versions...
dyld_stubs imps
| needImportedSymbols arch os
= Pretty.vcat $
= vcat $
(pprGotDeclaration arch os :) $
map ( pprImportedSymbol platform . fst . head) $
groupBy (\(_,a) (_,b) -> a == b) $
......@@ -551,7 +550,7 @@ makeImportsDoc dflags imports
map doPpr $
imps
| otherwise
= Pretty.empty
= empty
doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel platform lbl) astyle)
astyle = mkCodeStyle AsmStyle
......
compiler/nativeGen/PIC.hs
View file @ a12b6bf8
......@@ -77,10 +77,8 @@ import CLabel ( mkForeignLabel )
import StaticFlags ( opt_PIC, opt_Static )
import BasicTypes
import Pretty
import qualified Outputable
import Outputable
import Panic ( panic )
import DynFlags
import FastString
......@@ -421,19 +419,6 @@ picRelative _ _ _
--------------------------------------------------------------------------------
-- utility function for pretty-printing asm-labels,
-- copied from PprMach
--
asmSDoc :: Outputable.SDoc -> Doc
asmSDoc d
= Outputable.withPprStyleDoc
(Outputable.mkCodeStyle Outputable.AsmStyle) d
pprCLabel_asm :: Platform -> CLabel -> Doc
pprCLabel_asm platform l
= asmSDoc (pprCLabel platform l)
needImportedSymbols :: Arch -> OS -> Bool
needImportedSymbols arch os
| os == OSDarwin
......@@ -468,7 +453,7 @@ gotLabel
--------------------------------------------------------------------------------
-- We don't need to declare any offset tables.
-- However, for PIC on x86, we need a small helper function.
pprGotDeclaration :: Arch -> OS -> Doc
pprGotDeclaration :: Arch -> OS -> SDoc
pprGotDeclaration ArchX86 OSDarwin
| opt_PIC
= vcat [
......@@ -480,7 +465,7 @@ pprGotDeclaration ArchX86 OSDarwin
ptext (sLit "\tret") ]
pprGotDeclaration _ OSDarwin
= Pretty.empty
= empty
-- pprGotDeclaration
-- Output whatever needs to be output once per .s file.
......@@ -491,7 +476,7 @@ pprGotDeclaration arch os
| osElfTarget os
, arch /= ArchPPC_64
, not opt_PIC
= Pretty.empty
= empty
| osElfTarget os
, arch /= ArchPPC_64
......@@ -511,21 +496,21 @@ pprGotDeclaration _ _
-- Whenever you change something in this assembler output, make sure
-- the splitter in driver/split/ghc-split.lprl recognizes the new output
pprImportedSymbol :: Platform -> CLabel -> Doc
pprImportedSymbol :: Platform -> CLabel -> SDoc
pprImportedSymbol platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case opt_PIC of
False ->
vcat [
ptext (sLit ".symbol_stub"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\tlis r11,ha16(L") <> pprCLabel_asm platform lbl
ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\tlis r11,ha16(L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr)"),
ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel_asm platform lbl
ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr)(r11)"),
ptext (sLit "\tmtctr r12"),
ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel_asm platform lbl
ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr)"),
ptext (sLit "\tbctr")
]
......@@ -534,32 +519,32 @@ pprImportedSymbol platform@(Platform { platformArch = ArchPPC, platformOS = OSDa
ptext (sLit ".section __TEXT,__picsymbolstub1,")
<> ptext (sLit "symbol_stubs,pure_instructions,32"),
ptext (sLit "\t.align 2"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\tmflr r0"),
ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel_asm platform lbl,
ptext (sLit "L0$") <> pprCLabel_asm platform lbl <> char ':',
ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel platform lbl,
ptext (sLit "L0$") <> pprCLabel platform lbl <> char ':',
ptext (sLit "\tmflr r11"),
ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm platform lbl <> char ')',
ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel platform lbl <> char ')',
ptext (sLit "\tmtlr r0"),
ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm platform lbl
ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel platform lbl
<> ptext (sLit ")(r11)"),
ptext (sLit "\tmtctr r12"),
ptext (sLit "\tbctr")
]
$+$ vcat [
ptext (sLit ".lazy_symbol_pointer"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\t.long dyld_stub_binding_helper")]
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
ptext (sLit ".non_lazy_symbol_pointer"),
char 'L' <> pprCLabel_asm platform lbl <> ptext (sLit "$non_lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
char 'L' <> pprCLabel platform lbl <> ptext (sLit "$non_lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\t.long\t0")]
| otherwise
......@@ -572,13 +557,13 @@ pprImportedSymbol platform@(Platform { platformArch = ArchX86, platformOS = OSDa
False ->
vcat [
ptext (sLit ".symbol_stub"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\tjmp *L") <> pprCLabel_asm platform lbl
ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\tjmp *L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr"),
ptext (sLit "L") <> pprCLabel_asm platform lbl
ptext (sLit "L") <> pprCLabel platform lbl
<> ptext (sLit "$stub_binder:"),
ptext (sLit "\tpushl $L") <> pprCLabel_asm platform lbl
ptext (sLit "\tpushl $L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr"),
ptext (sLit "\tjmp dyld_stub_binding_helper")
]
......@@ -586,16 +571,16 @@ pprImportedSymbol platform@(Platform { platformArch = ArchX86, platformOS = OSDa
vcat [
ptext (sLit ".section __TEXT,__picsymbolstub2,")
<> ptext (sLit "symbol_stubs,pure_instructions,25"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\tcall ___i686.get_pc_thunk.ax"),
ptext (sLit "1:"),
ptext (sLit "\tmovl L") <> pprCLabel_asm platform lbl
ptext (sLit "\tmovl L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr-1b(%eax),%edx"),
ptext (sLit "\tjmp *%edx"),
ptext (sLit "L") <> pprCLabel_asm platform lbl
ptext (sLit "L") <> pprCLabel platform lbl
<> ptext (sLit "$stub_binder:"),
ptext (sLit "\tlea L") <> pprCLabel_asm platform lbl
ptext (sLit "\tlea L") <> pprCLabel platform lbl
<> ptext (sLit "$lazy_ptr-1b(%eax),%eax"),
ptext (sLit "\tpushl %eax"),
ptext (sLit "\tjmp dyld_stub_binding_helper")
......@@ -603,16 +588,16 @@ pprImportedSymbol platform@(Platform { platformArch = ArchX86, platformOS = OSDa
$+$ vcat [ ptext (sLit ".section __DATA, __la_sym_ptr")
<> (if opt_PIC then int 2 else int 3)
<> ptext (sLit ",lazy_symbol_pointers"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\t.long L") <> pprCLabel_asm platform lbl
ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\t.long L") <> pprCLabel platform lbl
<> ptext (sLit "$stub_binder")]
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
ptext (sLit ".non_lazy_symbol_pointer"),
char 'L' <> pprCLabel_asm platform lbl <> ptext (sLit "$non_lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
char 'L' <> pprCLabel platform lbl <> ptext (sLit "$non_lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl,
ptext (sLit "\t.long\t0")]
| otherwise
......@@ -667,8 +652,8 @@ pprImportedSymbol platform importedLbl
in vcat [
ptext (sLit ".section \".got2\", \"aw\""),
ptext (sLit ".LC_") <> pprCLabel_asm platform lbl <> char ':',
ptext symbolSize <+> pprCLabel_asm platform lbl ]
ptext (sLit ".LC_") <> pprCLabel platform lbl <> char ':',
ptext symbolSize <+> pprCLabel platform lbl ]
-- PLT code stubs are generated automatically by the dynamic linker.
_ -> empty
......
compiler/nativeGen/PPC/Ppr.hs
View file @ a12b6bf8
......@@ -35,10 +35,8 @@ import CLabel
import Unique ( pprUnique, Uniquable(..) )
import Platform
import Pretty
import FastString
import qualified Outputable
import Outputable ( PlatformOutputable, panic )
import Outputable
import Data.Word
import Data.Bits
......@@ -47,7 +45,7 @@ import Data.Bits
-- -----------------------------------------------------------------------------
-- Printing this stuff out
pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> Doc
pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> SDoc
pprNatCmmDecl platform (CmmData section dats) =
pprSectionHeader platform section $$ pprDatas platform dats
......@@ -65,7 +63,7 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
pprSectionHeader platform Text $$
(
(if platformHasSubsectionsViaSymbols platform
then pprCLabel_asm platform (mkDeadStripPreventer info_lbl) <> char ':'
then pprCLabel platform (mkDeadStripPreventer info_lbl) <> char ':'
else empty) $$
vcat (map (pprData platform) info) $$
pprLabel platform info_lbl
......@@ -82,23 +80,23 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
-- so that the linker will not think it is unreferenced and dead-strip
-- it. That's why the label is called a DeadStripPreventer (_dsp).
text "\t.long "
<+> pprCLabel_asm platform info_lbl
<+> pprCLabel platform info_lbl
<+> char '-'
<+> pprCLabel_asm platform (mkDeadStripPreventer info_lbl)
<+> pprCLabel platform (mkDeadStripPreventer info_lbl)
else empty)
pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc
pprBasicBlock :: Platform -> NatBasicBlock Instr -> SDoc
pprBasicBlock platform (BasicBlock blockid instrs) =
pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$
vcat (map (pprInstr platform) instrs)
pprDatas :: Platform -> CmmStatics -> Doc
pprDatas :: Platform -> CmmStatics -> SDoc
pprDatas platform (Statics lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
pprData :: Platform -> CmmStatic -> Doc
pprData :: Platform -> CmmStatic -> SDoc
pprData _ (CmmString str) = pprASCII str
pprData platform (CmmUninitialised bytes) = ptext (sLit keyword) <> int bytes
where keyword = case platformOS platform of
......@@ -106,30 +104,30 @@ pprData platform (CmmUninitialised bytes) = ptext (sLit keyword) <> int bytes
_ -> ".skip "
pprData platform (CmmStaticLit lit) = pprDataItem platform lit
pprGloblDecl :: Platform -> CLabel -> Doc
pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl platform lbl
| not (externallyVisibleCLabel lbl) = empty
| otherwise = ptext (sLit ".globl ") <> pprCLabel_asm platform lbl
| otherwise = ptext (sLit ".globl ") <> pprCLabel platform lbl
pprTypeAndSizeDecl :: Platform -> CLabel -> Doc
pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl platform lbl
| platformOS platform == OSLinux && externallyVisibleCLabel lbl
= ptext (sLit ".type ") <>
pprCLabel_asm platform lbl <> ptext (sLit ", @object")
pprCLabel platform lbl <> ptext (sLit ", @object")
pprTypeAndSizeDecl _ _
= empty
pprLabel :: Platform -> CLabel -> Doc
pprLabel :: Platform -> CLabel -> SDoc
pprLabel platform lbl = pprGloblDecl platform lbl
$$ pprTypeAndSizeDecl platform lbl
$$ (pprCLabel_asm platform lbl <> char ':')
$$ (pprCLabel platform lbl <> char ':')
pprASCII :: [Word8] -> Doc
pprASCII :: [Word8] -> SDoc
pprASCII str
= vcat (map do1 str) $$ do1 0
where
do1 :: Word8 -> Doc
do1 :: Word8 -> SDoc
do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
......@@ -137,22 +135,22 @@ pprASCII str
-- pprInstr: print an 'Instr'
instance PlatformOutputable Instr where
pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr
pprPlatform platform instr = pprInstr platform instr
pprReg :: Platform -> Reg -> Doc
pprReg :: Platform -> Reg -> SDoc
pprReg platform r
= case r of
RegReal (RealRegSingle i) -> ppr_reg_no i
RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch"
RegVirtual (VirtualRegI u) -> text "%vI_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegHi u) -> text "%vHi_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegF u) -> text "%vF_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUnique u
RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUnique u
RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUnique u
RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUnique u
RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> pprUnique u
where
ppr_reg_no :: Int -> Doc
ppr_reg_no :: Int -> SDoc
ppr_reg_no i =
case platformOS platform of
OSDarwin ->
......@@ -199,7 +197,7 @@ pprReg platform r
pprSize :: Size -> Doc
pprSize :: Size -> SDoc
pprSize x
= ptext (case x of
II8 -> sLit "b"
......@@ -210,7 +208,7 @@ pprSize x
_ -> panic "PPC.Ppr.pprSize: no match")
pprCond :: Cond -> Doc
pprCond :: Cond -> SDoc
pprCond c
= ptext (case c of {
ALWAYS -> sLit "";
......@@ -221,12 +219,12 @@ pprCond c
GU -> sLit "gt"; LEU -> sLit "le"; })
pprImm :: Platform -> Imm -> Doc
pprImm :: Platform -> Imm -> SDoc
pprImm _ (ImmInt i) = int i
pprImm _ (ImmInteger i) = integer i
pprImm platform (ImmCLbl l) = pprCLabel_asm platform l
pprImm platform (ImmIndex l i) = pprCLabel_asm platform l <> char '+' <> int i
pprImm platform (ImmCLbl l) = pprCLabel platform l
pprImm platform (ImmIndex l i) = pprCLabel platform l <> char '+' <> int i
pprImm _ (ImmLit s) = s
pprImm _ (ImmFloat _) = ptext (sLit "naughty float immediate")
......@@ -252,7 +250,7 @@ pprImm platform (HA i)
else pprImm platform i <> text "@ha"
pprAddr :: Platform -> AddrMode -> Doc
pprAddr :: Platform -> AddrMode -> SDoc
pprAddr platform (AddrRegReg r1 r2)
= pprReg platform r1 <+> ptext (sLit ", ") <+> pprReg platform r2
......@@ -261,7 +259,7 @@ pprAddr platform (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pp
pprAddr platform (AddrRegImm r1 imm) = hcat [ pprImm platform imm, char '(', pprReg platform r1, char ')' ]
pprSectionHeader :: Platform -> Section -> Doc
pprSectionHeader :: Platform -> Section -> SDoc
pprSectionHeader platform seg
= case seg of
Text -> ptext (sLit ".text\n.align 2")
......@@ -283,7 +281,7 @@ pprSectionHeader platform seg
where osDarwin = platformOS platform == OSDarwin
pprDataItem :: Platform -> CmmLit -> Doc
pprDataItem :: Platform -> CmmLit -> SDoc
pprDataItem platform lit
= vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
where
......@@ -314,7 +312,7 @@ pprDataItem platform lit
= panic "PPC.Ppr.pprDataItem: no match"
pprInstr :: Platform -> Instr -> Doc
pprInstr :: Platform -> Instr -> SDoc
pprInstr _ (COMMENT _) = empty -- nuke 'em
{-
......@@ -473,7 +471,7 @@ pprInstr platform (BCC cond blockid) = hcat [
ptext (sLit "b"),
pprCond cond,
char '\t',
pprCLabel_asm platform lbl
pprCLabel platform lbl
]
where lbl = mkAsmTempLabel (getUnique blockid)
......@@ -485,7 +483,7 @@ pprInstr platform (BCCFAR cond blockid) = vcat [
],
hcat [
ptext (sLit "\tb\t"),
pprCLabel_asm platform lbl
pprCLabel platform lbl
]
]
where lbl = mkAsmTempLabel (getUnique blockid)
......@@ -494,7 +492,7 @@ pprInstr platform (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
char '\t',
ptext (sLit "b"),
char '\t',
pprCLabel_asm platform lbl
pprCLabel platform lbl
]
pprInstr platform (MTCTR reg) = hcat [
......@@ -509,7 +507,7 @@ pprInstr _ (BCTR _ _) = hcat [
]
pprInstr platform (BL lbl _) = hcat [
ptext (sLit "\tbl\t"),
pprCLabel_asm platform lbl
pprCLabel platform lbl
]
pprInstr _ (BCTRL _) = hcat [
char '\t',
......@@ -663,7 +661,7 @@ pprInstr _ LWSYNC = ptext (sLit "\tlwsync")
-- pprInstr _ _ = panic "pprInstr (ppc)"
pprLogic :: Platform -> LitString -> Reg -> Reg -> RI -> Doc
pprLogic :: Platform -> LitString -> Reg -> Reg -> RI -> SDoc
pprLogic platform op reg1 reg2 ri = hcat [
char '\t',
ptext op,
......@@ -679,7 +677,7 @@ pprLogic platform op reg1 reg2 ri = hcat [
]
pprUnary :: Platform -> LitString -> Reg -> Reg -> Doc
pprUnary :: Platform -> LitString -> Reg -> Reg -> SDoc
pprUnary platform op reg1 reg2 = hcat [
char '\t',
ptext op,
......@@ -690,7 +688,7 @@ pprUnary platform op reg1 reg2 = hcat [
]
pprBinaryF :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprBinaryF :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> SDoc
pprBinaryF platform op sz reg1 reg2 reg3 = hcat [
char '\t',
ptext op,
......@@ -703,12 +701,12 @@ pprBinaryF platform op sz reg1 reg2 reg3 = hcat [
pprReg platform reg3
]
pprRI :: Platform -> RI -> Doc
pprRI :: Platform -> RI -> SDoc
pprRI platform (RIReg r) = pprReg platform r
pprRI platform (RIImm r) = pprImm platform r
pprFSize :: Size -> Doc