X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=7f72f4d0caa8776e958c06b6d67620ed8aacac02;hb=4c892ba00b965e000246fb1f5954ee73cb1b24c0;hp=617ba89b29e1208c9db340f1e55df04522989c78;hpb=446a82f58ad1d7d3f562420262985a6a84e1e2f0;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 617ba89..7f72f4d 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -1,5 +1,5 @@ % -% (c) The AQUA Project, Glasgow University, 1996 +% (c) The AQUA Project, Glasgow University, 1996-1998 % \section[PprMach]{Pretty-printing assembly language} @@ -8,37 +8,25 @@ We start with the @pprXXX@s with some cross-platform commonality @pprInstr@. \begin{code} -#include "HsVersions.h" #include "nativeGen/NCG.h" module PprMach ( pprInstr ) where -IMPORT_1_3(Char(isPrint,isDigit)) -#if __GLASGOW_HASKELL__ == 201 -import qualified GHCbase(Addr(..)) -- to see innards -IMP_Ubiq(){-uitious-} -#else -IMP_Ubiq(){-uitious-} -#endif +#include "HsVersions.h" import MachRegs -- may differ per-platform import MachMisc -import AbsCSyn ( MagicId ) import CLabel ( pprCLabel_asm, externallyVisibleCLabel ) import CStrings ( charToC ) import Maybes ( maybeToBool ) -import OrdList ( OrdList ) -import Stix ( CodeSegment(..), StixTree ) -import Pretty -- all of it +import Stix ( CodeSegment(..), StixTree(..) ) +import Char ( isPrint, isDigit ) +import Outputable -#if __GLASGOW_HASKELL__ == 201 -a_HASH x = GHCbase.A# x -pACK_STR x = packCString x -#else -a_HASH x = A# x -pACK_STR x = mkFastCharString x --_packCString x -#endif +import ST +import MutableArray +import Char ( ord ) \end{code} %************************************************************************ @@ -50,7 +38,7 @@ pACK_STR x = mkFastCharString x --_packCString x For x86, the way we print a register name depends on which bit of it we care about. Yurgh. \begin{code} -pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc +pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc pprReg IF_ARCH_i386(s,) r = case r of @@ -59,7 +47,7 @@ pprReg IF_ARCH_i386(s,) r other -> text (show other) -- should only happen when debugging where #if alpha_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> Doc + ppr_reg_no :: FAST_REG_NO -> SDoc ppr_reg_no i = ptext (case i of { ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1"); @@ -98,7 +86,7 @@ pprReg IF_ARCH_i386(s,) r }) #endif #if i386_TARGET_ARCH - ppr_reg_no :: Size -> FAST_REG_NO -> Doc + ppr_reg_no :: Size -> FAST_REG_NO -> SDoc ppr_reg_no B i = ptext (case i of { ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl"); @@ -106,14 +94,14 @@ pprReg IF_ARCH_i386(s,) r _ -> SLIT("very naughty I386 byte register") }) - {- UNUSED: +{- UNUSED: ppr_reg_no HB i = ptext (case i of { ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh"); ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh"); _ -> SLIT("very naughty I386 high byte register") }) - -} +-} {- UNUSED: ppr_reg_no S i = ptext @@ -137,26 +125,22 @@ pprReg IF_ARCH_i386(s,) r ppr_reg_no F i = ptext (case i of { - --ToDo: rm these (???) - ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)"); - ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)"); - ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)"); - ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)"); + ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1"); + ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3"); + ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5"); _ -> SLIT("very naughty I386 float register") }) ppr_reg_no DF i = ptext (case i of { - --ToDo: rm these (???) - ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)"); - ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)"); - ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)"); - ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)"); + ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1"); + ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3"); + ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5"); _ -> SLIT("very naughty I386 float register") }) #endif #if sparc_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> Doc + ppr_reg_no :: FAST_REG_NO -> SDoc ppr_reg_no i = ptext (case i of { ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1"); @@ -203,7 +187,7 @@ pprReg IF_ARCH_i386(s,) r %************************************************************************ \begin{code} -pprSize :: Size -> Doc +pprSize :: Size -> SDoc pprSize x = ptext (case x of #if alpha_TARGET_ARCH @@ -237,7 +221,7 @@ pprSize x = ptext (case x of -- D -> SLIT("d") UNUSED DF -> SLIT("d") ) -pprStSize :: Size -> Doc +pprStSize :: Size -> SDoc pprStSize x = ptext (case x of B -> SLIT("b") BU -> SLIT("b") @@ -258,7 +242,7 @@ pprStSize x = ptext (case x of %************************************************************************ \begin{code} -pprCond :: Cond -> Doc +pprCond :: Cond -> SDoc pprCond c = ptext (case c of { #if alpha_TARGET_ARCH @@ -300,11 +284,12 @@ pprCond c = ptext (case c of { %************************************************************************ \begin{code} -pprImm :: Imm -> Doc +pprImm :: Imm -> SDoc pprImm (ImmInt i) = int i pprImm (ImmInteger i) = integer i pprImm (ImmCLbl l) = pprCLabel_asm l +pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i pprImm (ImmLit s) = s pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s @@ -314,12 +299,12 @@ pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s pprImm (LO i) = hcat [ pp_lo, pprImm i, rparen ] where - pp_lo = ptext (pACK_STR (a_HASH "%lo("#)) + pp_lo = text "%lo(" pprImm (HI i) = hcat [ pp_hi, pprImm i, rparen ] where - pp_hi = ptext (pACK_STR (a_HASH "%hi("#)) + pp_hi = text "%hi(" #endif \end{code} @@ -330,7 +315,7 @@ pprImm (HI i) %************************************************************************ \begin{code} -pprAddr :: Address -> Doc +pprAddr :: MachRegsAddr -> SDoc #if alpha_TARGET_ARCH pprAddr (AddrReg r) = parens (pprReg r) @@ -353,7 +338,7 @@ pprAddr (ImmAddr imm off) else hcat [pp_imm, char '+', int off] -pprAddr (Address base index displacement) +pprAddr (AddrBaseIndex base index displacement) = let pp_disp = ppr_disp displacement pp_off p = (<>) pp_disp (parens p) @@ -403,26 +388,27 @@ pprAddr (AddrRegImm r1 imm) %************************************************************************ \begin{code} -pprInstr :: Instr -> Doc +pprInstr :: Instr -> SDoc ---pprInstr (COMMENT s) = (<>) (ptext SLIT("# ")) (ptext s) -pprInstr (COMMENT s) = empty -- nuke 'em ---alpha: = (<>) (ptext SLIT("\t# ")) (ptext s) ---i386 : = (<>) (ptext SLIT("# ")) (ptext s) ---sparc: = (<>) (ptext SLIT("! ")) (ptext s) +--pprInstr (COMMENT s) = empty -- nuke 'em +pprInstr (COMMENT s) + = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s)) + ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ptext s)) + ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ptext s)) + ,))) pprInstr (SEGMENT TextSegment) = ptext IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-} ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-} - ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-} + ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-} ,))) pprInstr (SEGMENT DataSegment) = ptext IF_ARCH_alpha(SLIT("\t.data\n\t.align 3") ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -} - ,IF_ARCH_i386(SLIT(".data\n\t.align 2") + ,IF_ARCH_i386(SLIT(".data\n\t.align 4") ,))) pprInstr (LABEL clab) @@ -449,18 +435,19 @@ pprInstr (ASCII False{-no backslash conversion-} str) pprInstr (ASCII True str) = (<>) (text "\t.ascii \"") (asciify str 60) where - asciify :: String -> Int -> Doc + asciify :: String -> Int -> SDoc asciify [] _ = text "\\0\"" asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60) asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1)) asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1)) asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1)) - asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")) + asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-} asciify (c:(cs@(d:_))) n | isDigit d = (<>) (text (charToC c)) (asciify cs 0) | otherwise = (<>) (text (charToC c)) (asciify cs (n-1)) +#if 0 pprInstr (DATA s xs) = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs] where @@ -468,22 +455,13 @@ pprInstr (DATA s xs) #if alpha_TARGET_ARCH B -> SLIT("\t.byte\t") BU -> SLIT("\t.byte\t") ---UNUSED: W -> SLIT("\t.word\t") ---UNUSED: WU -> SLIT("\t.word\t") ---UNUSED: L -> SLIT("\t.long\t") Q -> SLIT("\t.quad\t") ---UNUSED: FF -> SLIT("\t.f_floating\t") ---UNUSED: DF -> SLIT("\t.d_floating\t") ---UNUSED: GF -> SLIT("\t.g_floating\t") ---UNUSED: SF -> SLIT("\t.s_floating\t") TF -> SLIT("\t.t_floating\t") #endif #if i386_TARGET_ARCH B -> SLIT("\t.byte\t") ---UNUSED: HB -> SLIT("\t.byte\t") ---UNUSED: S -> SLIT("\t.word\t") L -> SLIT("\t.long\t") - F -> SLIT("\t.long\t") + F -> SLIT("\t.float\t") DF -> SLIT("\t.double\t") #endif #if sparc_TARGET_ARCH @@ -492,6 +470,71 @@ pprInstr (DATA s xs) W -> SLIT("\t.word\t") DF -> SLIT("\t.double\t") #endif +#endif + + +pprInstr (DATA s xs) + = vcat (concatMap (ppr_item s) xs) + where +#if alpha_TARGET_ARCH + ppr_item = error "ppr_item on Alpha" +#if 0 + This needs to be fixed. + B -> SLIT("\t.byte\t") + BU -> SLIT("\t.byte\t") + Q -> SLIT("\t.quad\t") + TF -> SLIT("\t.t_floating\t") +#endif +#endif +#if sparc_TARGET_ARCH + ppr_item = error "ppr_item on Sparc" +#if 0 + This needs to be fixed. + B -> SLIT("\t.byte\t") + BU -> SLIT("\t.byte\t") + W -> SLIT("\t.word\t") + DF -> SLIT("\t.double\t") +#endif +#endif +#if i386_TARGET_ARCH + ppr_item B x = [text "\t.byte\t" <> pprImm x] + ppr_item L x = [text "\t.long\t" <> pprImm x] + ppr_item F (ImmDouble r) + = let bs = floatToBytes (fromRational r) + in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs + ppr_item DF (ImmDouble r) + = let bs = doubleToBytes (fromRational r) + in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs + + floatToBytes :: Float -> [Int] + floatToBytes f + = runST (do + arr <- newFloatArray ((0::Int),3) + writeFloatArray arr 0 f + i0 <- readCharArray arr 0 + i1 <- readCharArray arr 1 + i2 <- readCharArray arr 2 + i3 <- readCharArray arr 3 + return (map ord [i0,i1,i2,i3]) + ) + + doubleToBytes :: Double -> [Int] + doubleToBytes d + = runST (do + arr <- newDoubleArray ((0::Int),7) + writeDoubleArray arr 0 d + i0 <- readCharArray arr 0 + i1 <- readCharArray arr 1 + i2 <- readCharArray arr 2 + i3 <- readCharArray arr 3 + i4 <- readCharArray arr 4 + i5 <- readCharArray arr 5 + i6 <- readCharArray arr 6 + i7 <- readCharArray arr 7 + return (map ord [i0,i1,i2,i3,i4,i5,i6,i7]) + ) + +#endif -- fall through to rest of (machine-specific) pprInstr... \end{code} @@ -834,8 +877,12 @@ pprInstr (FUNBEGIN clab) where pp_lab = pprCLabel_asm clab - pp_ldgp = ptext (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#)) - pp_frame = ptext (pACK_STR (a_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#)) + -- 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) @@ -843,12 +890,12 @@ pprInstr (FUNEND clab) Continue with Alpha-only printing bits and bobs: \begin{code} -pprRI :: RI -> Doc +pprRI :: RI -> SDoc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc +pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc pprRegRIReg name reg1 ri reg2 = hcat [ @@ -862,7 +909,7 @@ pprRegRIReg name reg1 ri reg2 pprReg reg2 ] -pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc +pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc pprSizeRegRegReg name size reg1 reg2 reg3 = hcat [ @@ -904,13 +951,13 @@ pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst -- here we do some patching, since the physical registers are only set late -- in the code generation. -pprInstr (LEA size (OpAddr (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) | reg1 == reg3 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst -pprInstr (LEA size (OpAddr (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) | reg2 == reg3 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst -pprInstr (LEA size (OpAddr (Address src1@(Just reg1) Nothing displ)) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3)) | reg1 == reg3 = pprInstr (ADD size (OpImm displ) dst) pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst @@ -939,6 +986,8 @@ pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op pprInstr (POP size op) = pprSizeOp SLIT("pop") size op +pprInstr PUSHA = ptext SLIT("\tpushal") +pprInstr POPA = ptext SLIT("\tpopal") pprInstr (NOP) = ptext SLIT("\tnop") pprInstr (CLTD) = ptext SLIT("\tcltd") @@ -949,86 +998,133 @@ pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab) pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op) - pprInstr (CALL imm) - = hcat [ ptext SLIT("\tcall "), pprImm imm ] - -pprInstr SAHF = ptext SLIT("\tsahf") -pprInstr FABS = ptext SLIT("\tfabs") - -pprInstr (FADD sz src@(OpAddr _)) - = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src] -pprInstr (FADD sz src) - = ptext SLIT("\tfadd") -pprInstr FADDP - = ptext SLIT("\tfaddp") -pprInstr (FMUL sz src) - = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src] -pprInstr FMULP - = ptext SLIT("\tfmulp") -pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op -pprInstr FCHS = ptext SLIT("\tfchs") -pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op -pprInstr FCOS = ptext SLIT("\tfcos") -pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op -pprInstr (FDIV sz src) - = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src] -pprInstr FDIVP - = ptext SLIT("\tfdivp") -pprInstr (FDIVR sz src) - = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src] -pprInstr FDIVRP - = ptext SLIT("\tfdivpr") -pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op -pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op -pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg -pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op -pprInstr (FLD sz (OpImm (ImmCLbl src))) - = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src] -pprInstr (FLD sz src) - = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src] -pprInstr FLD1 = ptext SLIT("\tfld1") -pprInstr FLDZ = ptext SLIT("\tfldz") -pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op -pprInstr FRNDINT = ptext SLIT("\tfrndint") -pprInstr FSIN = ptext SLIT("\tfsin") -pprInstr FSQRT = ptext SLIT("\tfsqrt") -pprInstr (FST sz dst) - = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst] -pprInstr (FSTP sz dst) - = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst] -pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op -pprInstr (FSUB sz src) - = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src] -pprInstr FSUBP - = ptext SLIT("\tfsubp") -pprInstr (FSUBR size src) - = pprSizeOp SLIT("fsubr") size src -pprInstr FSUBRP - = ptext SLIT("\tfsubpr") -pprInstr (FISUBR size op) - = pprSizeAddr SLIT("fisubr") size op -pprInstr FTST = ptext SLIT("\tftst") -pprInstr (FCOMP sz op) - = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op] -pprInstr FUCOMPP = ptext SLIT("\tfucompp") -pprInstr FXCH = ptext SLIT("\tfxch") -pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax") -pprInstr FNOP = ptext SLIT("") + = (<>) (ptext SLIT("\tcall ")) (pprImm imm) + + +-- Simulating a flat register set on the x86 FP stack is tricky. +-- you have to free %st(7) before pushing anything on the FP reg stack +-- so as to preclude the possibility of a FP stack overflow exception. +pprInstr g@(GMOV src dst) + | src == dst + = empty + | otherwise + = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1]) + +-- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1) +pprInstr g@(GLD sz addr dst) + = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp, + pprAddr addr, gsemi, gpop dst 1]) + +-- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr +pprInstr g@(GST sz src addr) + = pprG g (hcat [gtab, gpush src 0, gsemi, + text "fstp", pprSize sz, gsp, pprAddr addr]) + +pprInstr g@(GFTOD src dst) + = pprG g bogus +pprInstr g@(GFTOI src dst) + = pprG g bogus + +pprInstr g@(GDTOF src dst) + = pprG g bogus +pprInstr g@(GDTOI src dst) + = pprG g bogus + +pprInstr g@(GITOF src dst) + = pprG g bogus +pprInstr g@(GITOD src dst) + = pprG g bogus + +pprInstr g@(GCMP sz src1 src2) + = pprG g (hcat [gtab, text "pushl %eax ; ", + gpush src2 0, gsemi, gpush src1 1] + $$ + hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"]) + +pprInstr g@(GABS sz src dst) + = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1]) +pprInstr g@(GNEG sz src dst) + = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1]) +pprInstr g@(GSQRT sz src dst) + = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt ; ", gpop dst 1]) + +pprInstr g@(GADD sz src1 src2 dst) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fadd ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) +pprInstr g@(GSUB sz src1 src2 dst) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fsub ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) +pprInstr g@(GMUL sz src1 src2 dst) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fmul ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) +pprInstr g@(GDIV sz src1 src2 dst) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fdiv ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) + +pprInstr GFREE + = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"), + ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)") + ] + +-------------------------- +gpush reg offset + = hcat [text "ffree %st(7) ; fld ", greg reg offset] +gpop reg offset + = hcat [text "fstp ", greg reg offset] + +bogus = text "\tbogus" +greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')' +gsemi = text " ; " +gtab = char '\t' +gsp = char ' ' +gregno (FixedReg i) = I# i +gregno (MappedReg i) = I# i + +pprG :: Instr -> SDoc -> SDoc +pprG fake actual + = (char '#' <> pprGInstr fake) $$ actual + +pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst +pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst +pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst + +pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst +pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst + +pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst +pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst + +pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst +pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst + +pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst +pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst +pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst +pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst + +pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst +pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst +pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst +pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst \end{code} Continue with I386-only printing bits and bobs: \begin{code} -pprDollImm :: Imm -> Doc +pprDollImm :: Imm -> SDoc pprDollImm i = hcat [ ptext SLIT("$"), pprImm i] -pprOperand :: Size -> Operand -> Doc +pprOperand :: Size -> Operand -> SDoc pprOperand s (OpReg r) = pprReg s r pprOperand s (OpImm i) = pprDollImm i pprOperand s (OpAddr ea) = pprAddr ea -pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc +pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc pprSizeOp name size op1 = hcat [ char '\t', @@ -1038,7 +1134,7 @@ pprSizeOp name size op1 pprOperand size op1 ] -pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc +pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc pprSizeOpOp name size op1 op2 = hcat [ char '\t', @@ -1050,7 +1146,7 @@ pprSizeOpOp name size op1 op2 pprOperand size op2 ] -pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc +pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc pprSizeByteOpOp name size op1 op2 = hcat [ char '\t', @@ -1062,7 +1158,7 @@ pprSizeByteOpOp name size op1 op2 pprOperand size op2 ] -pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc +pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc pprSizeOpReg name size op1 reg = hcat [ char '\t', @@ -1074,7 +1170,46 @@ pprSizeOpReg name size op1 reg pprReg size reg ] -pprSizeAddr :: FAST_STRING -> Size -> Address -> Doc +pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc +pprSizeRegReg name size reg1 reg2 + = hcat [ + char '\t', + ptext name, + pprSize size, + space, + pprReg size reg1, + comma, + pprReg size reg2 + ] + +pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc +pprSizeSizeRegReg name size1 size2 reg1 reg2 + = hcat [ + char '\t', + ptext name, + pprSize size1, + pprSize size2, + space, + pprReg size1 reg1, + comma, + pprReg size2 reg2 + ] + +pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc +pprSizeRegRegReg name size reg1 reg2 reg3 + = hcat [ + char '\t', + ptext name, + pprSize size, + space, + pprReg size reg1, + comma, + pprReg size reg2, + comma, + pprReg size reg3 + ] + +pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc pprSizeAddr name size op = hcat [ char '\t', @@ -1084,7 +1219,7 @@ pprSizeAddr name size op pprAddr op ] -pprSizeAddrReg :: FAST_STRING -> Size -> Address -> Reg -> Doc +pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc pprSizeAddrReg name size op dst = hcat [ char '\t', @@ -1096,7 +1231,19 @@ pprSizeAddrReg name size op dst pprReg size dst ] -pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc +pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc +pprSizeRegAddr name size src op + = hcat [ + char '\t', + ptext name, + pprSize size, + space, + pprReg size src, + comma, + pprAddr op + ] + +pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc pprOpOp name size op1 op2 = hcat [ char '\t', @@ -1106,7 +1253,7 @@ pprOpOp name size op1 op2 pprOperand size op2 ] -pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc +pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc pprSizeOpOpCoerce name size1 size2 op1 op2 = hcat [ char '\t', ptext name, space, pprOperand size1 op1, @@ -1114,7 +1261,7 @@ pprSizeOpOpCoerce name size1 size2 op1 op2 pprOperand size2 op2 ] -pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc +pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc pprCondInstr name cond arg = hcat [ char '\t', ptext name, pprCond cond, space, arg] @@ -1326,11 +1473,11 @@ pprInstr (CALL imm n _) Continue with SPARC-only printing bits and bobs: \begin{code} -pprRI :: RI -> Doc +pprRI :: RI -> SDoc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc +pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc pprSizeRegReg name size reg1 reg2 = hcat [ char '\t', @@ -1343,7 +1490,7 @@ pprSizeRegReg name size reg1 reg2 pprReg reg2 ] -pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc +pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc pprSizeRegRegReg name size reg1 reg2 reg3 = hcat [ char '\t', @@ -1358,7 +1505,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3 pprReg reg3 ] -pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc +pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc pprRegRIReg name b reg1 ri reg2 = hcat [ char '\t', @@ -1371,7 +1518,7 @@ pprRegRIReg name b reg1 ri reg2 pprReg reg2 ] -pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc +pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc pprRIReg name b ri reg1 = hcat [ char '\t', @@ -1382,10 +1529,10 @@ pprRIReg name b ri reg1 pprReg reg1 ] -pp_ld_lbracket = ptext (pACK_STR (a_HASH "\tld\t["#)) -pp_rbracket_comma = ptext (pACK_STR (a_HASH "],"#)) -pp_comma_lbracket = ptext (pACK_STR (a_HASH ",["#)) -pp_comma_a = ptext (pACK_STR (a_HASH ",a"#)) +pp_ld_lbracket = ptext SLIT("\tld\t[") +pp_rbracket_comma = text "]," +pp_comma_lbracket = text ",[" +pp_comma_a = text ",a" #endif {-sparc_TARGET_ARCH-} \end{code}