NCG: Split PprMach into arch specific modules

  - There are still some #ifdefs for choosing between i386, x86_64,
      linux, darwin and other OS's.
  - Also reformat SPARC.RegInfo to remove some of the visual noise.
parent b5bb34f0
......@@ -459,21 +459,26 @@ Library
RegsBase
Instrs
RegAllocInfo
PprMach
PprBase
Alpha.Regs
Alpha.RegInfo
Alpha.Instr
Alpha.Ppr
X86.Regs
X86.RegInfo
X86.Instr
X86.Ppr
PPC.Regs
PPC.RegInfo
PPC.Instr
PPC.Ppr
SPARC.Regs
SPARC.RegInfo
SPARC.Instr
SPARC.Ppr
NCGMonad
PositionIndependentCode
PprMach
RegAlloc.Liveness
RegAlloc.Graph.Main
RegAlloc.Graph.Stats
......
module Alpha.Ppr (
{-
pprReg,
pprSize,
pprCond,
pprAddr,
pprSectionHeader,
pprTypeAndSizeDecl,
pprRI,
pprRegRIReg,
pprSizeRegRegReg
-}
)
where
{-
#include "nativeGen/NCG.h"
#include "HsVersions.h"
import BlockId
import Cmm
import Regs -- may differ per-platform
import Instrs
import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
#if HAVE_SUBSECTIONS_VIA_SYMBOLS
import CLabel ( mkDeadStripPreventer )
#endif
import Panic ( panic )
import Unique ( pprUnique )
import Pretty
import FastString
import qualified Outputable
import Outputable ( Outputable, pprPanic, ppr, docToSDoc)
import Data.Array.ST
import Data.Word ( Word8 )
import Control.Monad.ST
import Data.Char ( chr, ord )
import Data.Maybe ( isJust )
pprReg :: Reg -> Doc
pprReg r
= case r of
RealReg i -> ppr_reg_no i
VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
where
ppr_reg_no :: Int -> Doc
ppr_reg_no i = ptext
(case i of {
0 -> sLit "$0"; 1 -> sLit "$1";
2 -> sLit "$2"; 3 -> sLit "$3";
4 -> sLit "$4"; 5 -> sLit "$5";
6 -> sLit "$6"; 7 -> sLit "$7";
8 -> sLit "$8"; 9 -> sLit "$9";
10 -> sLit "$10"; 11 -> sLit "$11";
12 -> sLit "$12"; 13 -> sLit "$13";
14 -> sLit "$14"; 15 -> sLit "$15";
16 -> sLit "$16"; 17 -> sLit "$17";
18 -> sLit "$18"; 19 -> sLit "$19";
20 -> sLit "$20"; 21 -> sLit "$21";
22 -> sLit "$22"; 23 -> sLit "$23";
24 -> sLit "$24"; 25 -> sLit "$25";
26 -> sLit "$26"; 27 -> sLit "$27";
28 -> sLit "$28"; 29 -> sLit "$29";
30 -> sLit "$30"; 31 -> sLit "$31";
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 alpha register"
})
pprSize :: Size -> Doc
pprSize x = ptext (case x of
B -> sLit "b"
Bu -> sLit "bu"
-- W -> sLit "w" UNUSED
-- Wu -> sLit "wu" UNUSED
L -> sLit "l"
Q -> sLit "q"
-- FF -> sLit "f" UNUSED
-- DF -> sLit "d" UNUSED
-- GF -> sLit "g" UNUSED
-- SF -> sLit "s" UNUSED
TF -> sLit "t"
pprCond :: Cond -> Doc
pprCond c
= ptext (case c of
EQQ -> sLit "eq"
LTT -> sLit "lt"
LE -> sLit "le"
ULT -> sLit "ult"
ULE -> sLit "ule"
NE -> sLit "ne"
GTT -> sLit "gt"
GE -> sLit "ge")
pprAddr :: AddrMode -> Doc
pprAddr (AddrReg r) = parens (pprReg r)
pprAddr (AddrImm i) = pprImm i
pprAddr (AddrRegImm r1 i)
= (<>) (pprImm i) (parens (pprReg r1))
pprSectionHeader Text
= ptext (sLit "\t.text\n\t.align 3")
pprSectionHeader Data
= ptext (sLit "\t.data\n\t.align 3")
pprSectionHeader ReadOnlyData
= ptext (sLit "\t.data\n\t.align 3")
pprSectionHeader RelocatableReadOnlyData
= ptext (sLit "\t.data\n\t.align 3")
pprSectionHeader UninitialisedData
= ptext (sLit "\t.bss\n\t.align 3")
pprSectionHeader ReadOnlyData16
= ptext (sLit "\t.data\n\t.align 4")
pprSectionHeader (OtherSection sec)
= panic "PprMach.pprSectionHeader: unknown section"
pprTypeAndSizeDecl :: CLabel -> Doc
pprTypeAndSizeDecl lbl
= empty
pprInstr :: Instr -> Doc
pprInstr (COMMENT s) = empty -- nuke 'em
{-
pprInstr (COMMENT s)
= IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s))
,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
,IF_ARCH_powerpc( IF_OS_linux(
((<>) (ptext (sLit "# ")) (ftext s)),
((<>) (ptext (sLit "; ")) (ftext s)))
,)))))
-}
pprInstr (DELTA d)
= pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
pprInstr (NEWBLOCK _)
= panic "PprMach.pprInstr: NEWBLOCK"
pprInstr (LDATA _ _)
= panic "PprMach.pprInstr: LDATA"
pprInstr (SPILL reg slot)
= hcat [
ptext (sLit "\tSPILL"),
char '\t',
pprReg reg,
comma,
ptext (sLit "SLOT") <> parens (int slot)]
pprInstr (RELOAD slot reg)
= hcat [
ptext (sLit "\tRELOAD"),
char '\t',
ptext (sLit "SLOT") <> parens (int slot),
comma,
pprReg reg]
pprInstr (LD size reg addr)
= hcat [
ptext (sLit "\tld"),
pprSize size,
char '\t',
pprReg reg,
comma,
pprAddr addr
]
pprInstr (LDA reg addr)
= hcat [
ptext (sLit "\tlda\t"),
pprReg reg,
comma,
pprAddr addr
]
pprInstr (LDAH reg addr)
= hcat [
ptext (sLit "\tldah\t"),
pprReg reg,
comma,
pprAddr addr
]
pprInstr (LDGP reg addr)
= hcat [
ptext (sLit "\tldgp\t"),
pprReg reg,
comma,
pprAddr addr
]
pprInstr (LDI size reg imm)
= hcat [
ptext (sLit "\tldi"),
pprSize size,
char '\t',
pprReg reg,
comma,
pprImm imm
]
pprInstr (ST size reg addr)
= hcat [
ptext (sLit "\tst"),
pprSize size,
char '\t',
pprReg reg,
comma,
pprAddr addr
]
pprInstr (CLR reg)
= hcat [
ptext (sLit "\tclr\t"),
pprReg reg
]
pprInstr (ABS size ri reg)
= hcat [
ptext (sLit "\tabs"),
pprSize size,
char '\t',
pprRI ri,
comma,
pprReg reg
]
pprInstr (NEG size ov ri reg)
= hcat [
ptext (sLit "\tneg"),
pprSize size,
if ov then ptext (sLit "v\t") else char '\t',
pprRI ri,
comma,
pprReg reg
]
pprInstr (ADD size ov reg1 ri reg2)
= hcat [
ptext (sLit "\tadd"),
pprSize size,
if ov then ptext (sLit "v\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (SADD size scale reg1 ri reg2)
= hcat [
ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
ptext (sLit "add"),
pprSize size,
char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (SUB size ov reg1 ri reg2)
= hcat [
ptext (sLit "\tsub"),
pprSize size,
if ov then ptext (sLit "v\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (SSUB size scale reg1 ri reg2)
= hcat [
ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
ptext (sLit "sub"),
pprSize size,
char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (MUL size ov reg1 ri reg2)
= hcat [
ptext (sLit "\tmul"),
pprSize size,
if ov then ptext (sLit "v\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (DIV size uns reg1 ri reg2)
= hcat [
ptext (sLit "\tdiv"),
pprSize size,
if uns then ptext (sLit "u\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (REM size uns reg1 ri reg2)
= hcat [
ptext (sLit "\trem"),
pprSize size,
if uns then ptext (sLit "u\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (NOT ri reg)
= hcat [
ptext (sLit "\tnot"),
char '\t',
pprRI ri,
comma,
pprReg reg
]
pprInstr (AND reg1 ri reg2) = pprRegRIReg (sLit "and") reg1 ri reg2
pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg (sLit "andnot") reg1 ri reg2
pprInstr (OR reg1 ri reg2) = pprRegRIReg (sLit "or") reg1 ri reg2
pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg (sLit "ornot") reg1 ri reg2
pprInstr (XOR reg1 ri reg2) = pprRegRIReg (sLit "xor") reg1 ri reg2
pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg (sLit "xornot") reg1 ri reg2
pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") reg1 ri reg2
pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") reg1 ri reg2
pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") reg1 ri reg2
pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2
pprInstr (NOP) = ptext (sLit "\tnop")
pprInstr (CMP cond reg1 ri reg2)
= hcat [
ptext (sLit "\tcmp"),
pprCond cond,
char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprInstr (FCLR reg)
= hcat [
ptext (sLit "\tfclr\t"),
pprReg reg
]
pprInstr (FABS reg1 reg2)
= hcat [
ptext (sLit "\tfabs\t"),
pprReg reg1,
comma,
pprReg reg2
]
pprInstr (FNEG size reg1 reg2)
= hcat [
ptext (sLit "\tneg"),
pprSize size,
char '\t',
pprReg reg1,
comma,
pprReg reg2
]
pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "add") size reg1 reg2 reg3
pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "div") size reg1 reg2 reg3
pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "mul") size reg1 reg2 reg3
pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "sub") size reg1 reg2 reg3
pprInstr (CVTxy size1 size2 reg1 reg2)
= hcat [
ptext (sLit "\tcvt"),
pprSize size1,
case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
char '\t',
pprReg reg1,
comma,
pprReg reg2
]
pprInstr (FCMP size cond reg1 reg2 reg3)
= hcat [
ptext (sLit "\tcmp"),
pprSize size,
pprCond cond,
char '\t',
pprReg reg1,
comma,
pprReg reg2,
comma,
pprReg reg3
]
pprInstr (FMOV reg1 reg2)
= hcat [
ptext (sLit "\tfmov\t"),
pprReg reg1,
comma,
pprReg reg2
]
pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
pprInstr (BI NEVER reg lab) = empty
pprInstr (BI cond reg lab)
= hcat [
ptext (sLit "\tb"),
pprCond cond,
char '\t',
pprReg reg,
comma,
pprImm lab
]
pprInstr (BF cond reg lab)
= hcat [
ptext (sLit "\tfb"),
pprCond cond,
char '\t',
pprReg reg,
comma,
pprImm lab
]
pprInstr (BR lab)
= (<>) (ptext (sLit "\tbr\t")) (pprImm lab)
pprInstr (JMP reg addr hint)
= hcat [
ptext (sLit "\tjmp\t"),
pprReg reg,
comma,
pprAddr addr,
comma,
int hint
]
pprInstr (BSR imm n)
= (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)
pprInstr (JSR reg addr n)
= hcat [
ptext (sLit "\tjsr\t"),
pprReg reg,
comma,
pprAddr addr
]
pprInstr (FUNBEGIN clab)
= hcat [
if (externallyVisibleCLabel clab) then
hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
else
empty,
ptext (sLit "\t.ent "),
pp_lab,
char '\n',
pp_lab,
pp_ldgp,
pp_lab,
pp_frame
]
where
pp_lab = pprCLabel_asm clab
-- NEVER use commas within those string literals, cpp will ruin your day
pp_ldgp = hcat [ ptext (sLit ":\n\tldgp $29"), char ',', ptext (sLit "0($27)\n") ]
pp_frame = hcat [ ptext (sLit "..ng:\n\t.frame $30"), char ',',
ptext (sLit "4240"), char ',',
ptext (sLit "$26"), char ',',
ptext (sLit "0\n\t.prologue 1") ]
pprInstr (FUNEND clab)
= (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)
pprRI :: RI -> Doc
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
pprRegRIReg name reg1 ri reg2
= hcat [
char '\t',
ptext name,
char '\t',
pprReg reg1,
comma,
pprRI ri,
comma,
pprReg reg2
]
pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
char '\t',
ptext name,
pprSize size,
char '\t',
pprReg reg1,
comma,
pprReg reg2,
comma,
pprReg reg3
]
-}
-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------
module PPC.Ppr (
pprUserReg,
pprSize,
pprImm,
pprSectionHeader,
pprDataItem,
pprInstr
)
where
#include "nativeGen/NCG.h"
#include "HsVersions.h"
import RegsBase
import PprBase
import PPC.Regs
import PPC.Instr
import BlockId
import Cmm
import CLabel ( mkAsmTempLabel )
import Unique ( pprUnique )
import Pretty
import FastString
import qualified Outputable
import Outputable ( panic )
import Data.Word(Word32)
import Data.Bits
pprUserReg :: Reg -> Doc
pprUserReg = pprReg
pprReg :: Reg -> Doc