import MONAD_ST
import Char ( chr, ord )
+import Maybe ( isJust )
-#if powerpc_TARGET_ARCH
+#if powerpc_TARGET_ARCH || darwin_TARGET_OS
import DATA_WORD(Word32)
import DATA_BITS
#endif
-- -----------------------------------------------------------------------------
-- pprSize: print a 'Size'
-#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH
+#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
pprSize :: MachRep -> Doc
#else
pprSize :: Size -> Doc
F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
#endif
#if sparc_TARGET_ARCH
- B -> SLIT("sb")
- Bu -> SLIT("ub")
- H -> SLIT("sh")
- Hu -> SLIT("uh")
- W -> SLIT("")
- F -> SLIT("")
- DF -> SLIT("d")
+ I8 -> SLIT("sb")
+ I16 -> SLIT("sh")
+ I32 -> SLIT("")
+ F32 -> SLIT("")
+ F64 -> SLIT("d")
)
-pprStSize :: Size -> Doc
+pprStSize :: MachRep -> Doc
pprStSize x = ptext (case x of
- B -> SLIT("b")
- Bu -> SLIT("b")
- H -> SLIT("h")
- Hu -> SLIT("h")
- W -> SLIT("")
- F -> SLIT("")
- DF -> SLIT("d")
+ I8 -> SLIT("b")
+ I16 -> SLIT("h")
+ I32 -> SLIT("")
+ F32 -> SLIT("")
+ F64 -> SLIT("d")
#endif
#if powerpc_TARGET_ARCH
I8 -> SLIT("b")
pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
+#if sparc_TARGET_ARCH
+-- ToDo: This should really be fixed in the PIC support, but only
+-- print a for now.
+pprImm (ImmConstantDiff a b) = pprImm a
+#else
pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
<> lparen <> pprImm b <> rparen
+#endif
#if sparc_TARGET_ARCH
pprImm (LO i)
= ptext
IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
- ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
+ ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
+ SLIT(".text\n\t.align 4,0x90"))
+ {-needs per-OS variation!-}
,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") {-needs per-OS variation!-}
,IF_ARCH_powerpc(SLIT(".text\n.align 2")
,)))))
= ptext
IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
+ ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
+ SLIT(".data\n\t.align 4"))
,IF_ARCH_x86_64(SLIT(".data\n\t.align 8")
,IF_ARCH_powerpc(SLIT(".data\n.align 2")
,)))))
= ptext
IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
+ ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
+ SLIT(".section .rodata\n\t.align 4"))
,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
SLIT(".section .rodata\n\t.align 2"))
= ptext
IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
+ ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
+ SLIT(".section .rodata\n\t.align 4"))
,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
SLIT(".data\n\t.align 2"))
= ptext
IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(SLIT(".section .bss\n\t.align 4")
+ ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n\t.align 2"),
+ SLIT(".section .bss\n\t.align 4"))
,IF_ARCH_x86_64(SLIT(".section .bss\n\t.align 8")
,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
SLIT(".section .bss\n\t.align 2"))
= ptext
IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
- ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 16")
+ ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
+ SLIT(".section .rodata\n\t.align 16"))
,IF_ARCH_x86_64(SLIT(".section .rodata.cst16\n\t.align 16")
,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
SLIT(".section .rodata\n\t.align 4"))
pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
--- Assume we want to backslash-convert the string
pprASCII str
- = vcat (map do1 (str ++ [chr 0]))
+ = vcat (map do1 str) $$ do1 0
where
- do1 :: Char -> Doc
- do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
-
- hshow :: Int -> Doc
- hshow n | n >= 0 && n <= 255
- = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
- tab = "0123456789ABCDEF"
+ do1 :: Word8 -> Doc
+ do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
pprAlign bytes =
IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
- IF_ARCH_i386(ptext SLIT(".align ") <> int bytes,
+ IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes,
IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
#endif
+#if i386_TARGET_ARCH && darwin_TARGET_OS
+ ppr_item I64 (CmmInt x _) =
+ [ptext SLIT("\t.long\t")
+ <> int (fromIntegral (fromIntegral x :: Word32)),
+ ptext SLIT("\t.long\t")
+ <> int (fromIntegral
+ (fromIntegral (x `shiftR` 32) :: Word32))]
+#endif
#if i386_TARGET_ARCH
ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
#endif
pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
-pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
-pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
+pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
+pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sd") from to
#endif
+ -- FETCHGOT for PIC on ELF platforms
pprInstr (FETCHGOT reg)
= vcat [ ptext SLIT("\tcall 1f"),
hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
pprReg I32 reg ]
]
+ -- FETCHPC for PIC on Darwin/x86
+ -- get the instruction pointer into a register
+ -- (Terminology note: the IP is called Program Counter on PPC,
+ -- and it's a good thing to use the same name on both platforms)
+pprInstr (FETCHPC reg)
+ = vcat [ ptext SLIT("\tcall 1f"),
+ hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
+ ]
+
+
+
#endif
-- -----------------------------------------------------------------------------
-- ld [g1],%fn
-- ld [g1+4],%f(n+1)
-- sub g1,g2,g1 -- to restore g1
-pprInstr (LD DF (AddrRegReg g1 g2) reg)
+
+pprInstr (LD F64 (AddrRegReg g1 g2) reg)
= vcat [
hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
-- Translate to
-- ld [addr],%fn
-- ld [addr+4],%f(n+1)
-pprInstr (LD DF addr reg) | isJust off_addr
+pprInstr (LD F64 addr reg) | isJust off_addr
= vcat [
hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
-- st %fn,[g1]
-- st %f(n+1),[g1+4]
-- sub g1,g2,g1 -- to restore g1
-pprInstr (ST DF reg (AddrRegReg g1 g2))
+pprInstr (ST F64 reg (AddrRegReg g1 g2))
= vcat [
hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
-- Translate to
-- st %fn,[addr]
-- st %f(n+1),[addr+4]
-pprInstr (ST DF reg addr) | isJust off_addr
+pprInstr (ST F64 reg addr) | isJust off_addr
= vcat [
hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
pprAddr addr, rbrack],
pprInstr NOP = ptext SLIT("\tnop")
-pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
-pprInstr (FABS DF reg1 reg2)
- = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
+pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
+pprInstr (FABS F64 reg1 reg2)
+ = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
pprInstr (FADD size reg1 reg2 reg3)
= pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
pprInstr (FDIV size reg1 reg2 reg3)
= pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
-pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
-pprInstr (FMOV DF reg1 reg2)
- = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
+pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
+pprInstr (FMOV F64 reg1 reg2)
+ = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
pprInstr (FMUL size reg1 reg2 reg3)
= pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
-pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
-pprInstr (FNEG DF reg1 reg2)
- = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
+pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
+pprInstr (FNEG F64 reg1 reg2)
+ = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
ptext SLIT("\tf"),
ptext
(case size1 of
- W -> SLIT("ito")
- F -> SLIT("sto")
- DF -> SLIT("dto")),
+ I32 -> SLIT("ito")
+ F32 -> SLIT("sto")
+ F64 -> SLIT("dto")),
ptext
(case size2 of
- W -> SLIT("i\t")
- F -> SLIT("s\t")
- DF -> SLIT("d\t")),
+ I32 -> SLIT("i\t")
+ F32 -> SLIT("s\t")
+ F64 -> SLIT("d\t")),
pprReg reg1, comma, pprReg reg2
]
pprImm lab
]
-pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
+pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
pprInstr (CALL (Left imm) n _)
= hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
pprInstr (CALL (Right reg) n _)
= hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
-\end{code}
-Continue with SPARC-only printing bits and bobs:
-\begin{code}
pprRI :: RI -> Doc
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
-pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
pprSizeRegReg name size reg1 reg2
= hcat [
char '\t',
ptext name,
(case size of
- F -> ptext SLIT("s\t")
- DF -> ptext SLIT("d\t")),
+ F32 -> ptext SLIT("s\t")
+ F64 -> ptext SLIT("d\t")),
pprReg reg1,
comma,
pprReg reg2
]
-pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
char '\t',
ptext name,
(case size of
- F -> ptext SLIT("s\t")
- DF -> ptext SLIT("d\t")),
+ F32 -> ptext SLIT("s\t")
+ F64 -> ptext SLIT("d\t")),
pprReg reg1,
comma,
pprReg reg2,
projects / ghc-hetmet.git / blobdiff