From 0b975fd553c56db0b106608f4f27d379e75d68fd Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 23 Oct 2011 20:27:19 +0100 Subject: Remove half the CPP from nativeGen/PPC/Ppr.hs --- compiler/nativeGen/PPC/Ppr.hs | 246 +++++++++++++++++++++--------------------- 1 file changed, 120 insertions(+), 126 deletions(-) (limited to 'compiler/nativeGen') diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index 35c4d64ef8..361761216b 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -103,13 +103,10 @@ pprDatas platform (Statics lbl dats) = vcat (pprLabel platform lbl : map (pprDat pprData :: Platform -> CmmStatic -> Doc pprData _ (CmmString str) = pprASCII str - -#if darwin_TARGET_OS -pprData _ (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes -#else -pprData _ (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes -#endif - +pprData platform (CmmUninitialised bytes) = ptext (sLit keyword) <> int bytes + where keyword = case platformOS platform of + OSDarwin -> ".space " + _ -> ".skip " pprData platform (CmmStaticLit lit) = pprDataItem platform lit pprGloblDecl :: Platform -> CLabel -> Doc @@ -118,15 +115,12 @@ pprGloblDecl platform lbl | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm platform lbl pprTypeAndSizeDecl :: Platform -> CLabel -> Doc -#if linux_TARGET_OS pprTypeAndSizeDecl platform lbl - | not (externallyVisibleCLabel lbl) = empty - | otherwise = ptext (sLit ".type ") <> - pprCLabel_asm platform lbl <> ptext (sLit ", @object") -#else + | platformOS platform == OSLinux && externallyVisibleCLabel lbl + = ptext (sLit ".type ") <> + pprCLabel_asm platform lbl <> ptext (sLit ", @object") pprTypeAndSizeDecl _ _ = empty -#endif pprLabel :: Platform -> CLabel -> Doc pprLabel platform lbl = pprGloblDecl platform lbl @@ -149,9 +143,9 @@ instance PlatformOutputable Instr where pprPlatform platform instr = Outputable.docToSDoc $ pprInstr platform instr -pprReg :: Reg -> Doc +pprReg :: Platform -> Reg -> Doc -pprReg r +pprReg platform r = case r of RegReal (RealRegSingle i) -> ppr_reg_no i RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch" @@ -161,50 +155,50 @@ pprReg r RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u) RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> asmSDoc (pprUnique u) where -#if darwin_TARGET_OS ppr_reg_no :: Int -> Doc - ppr_reg_no i = ptext - (case i of { - 0 -> sLit "r0"; 1 -> sLit "r1"; - 2 -> sLit "r2"; 3 -> sLit "r3"; - 4 -> sLit "r4"; 5 -> sLit "r5"; - 6 -> sLit "r6"; 7 -> sLit "r7"; - 8 -> sLit "r8"; 9 -> sLit "r9"; - 10 -> sLit "r10"; 11 -> sLit "r11"; - 12 -> sLit "r12"; 13 -> sLit "r13"; - 14 -> sLit "r14"; 15 -> sLit "r15"; - 16 -> sLit "r16"; 17 -> sLit "r17"; - 18 -> sLit "r18"; 19 -> sLit "r19"; - 20 -> sLit "r20"; 21 -> sLit "r21"; - 22 -> sLit "r22"; 23 -> sLit "r23"; - 24 -> sLit "r24"; 25 -> sLit "r25"; - 26 -> sLit "r26"; 27 -> sLit "r27"; - 28 -> sLit "r28"; 29 -> sLit "r29"; - 30 -> sLit "r30"; 31 -> sLit "r31"; - 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 powerpc register" - }) -#else - ppr_reg_no :: Int -> Doc - ppr_reg_no i | i <= 31 = int i -- GPRs - | i <= 63 = int (i-32) -- FPRs - | otherwise = ptext (sLit "very naughty powerpc register") -#endif + ppr_reg_no i = + case platformOS platform of + OSDarwin -> + ptext + (case i of { + 0 -> sLit "r0"; 1 -> sLit "r1"; + 2 -> sLit "r2"; 3 -> sLit "r3"; + 4 -> sLit "r4"; 5 -> sLit "r5"; + 6 -> sLit "r6"; 7 -> sLit "r7"; + 8 -> sLit "r8"; 9 -> sLit "r9"; + 10 -> sLit "r10"; 11 -> sLit "r11"; + 12 -> sLit "r12"; 13 -> sLit "r13"; + 14 -> sLit "r14"; 15 -> sLit "r15"; + 16 -> sLit "r16"; 17 -> sLit "r17"; + 18 -> sLit "r18"; 19 -> sLit "r19"; + 20 -> sLit "r20"; 21 -> sLit "r21"; + 22 -> sLit "r22"; 23 -> sLit "r23"; + 24 -> sLit "r24"; 25 -> sLit "r25"; + 26 -> sLit "r26"; 27 -> sLit "r27"; + 28 -> sLit "r28"; 29 -> sLit "r29"; + 30 -> sLit "r30"; 31 -> sLit "r31"; + 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 powerpc register" + }) + _ + | i <= 31 -> int i -- GPRs + | i <= 63 -> int (i-32) -- FPRs + | otherwise -> ptext (sLit "very naughty powerpc register") @@ -275,12 +269,12 @@ pprImm platform (HA i) pprAddr :: Platform -> AddrMode -> Doc -pprAddr _ (AddrRegReg r1 r2) - = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2 +pprAddr platform (AddrRegReg r1 r2) + = pprReg platform r1 <+> ptext (sLit ", ") <+> pprReg platform r2 -pprAddr _ (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ] -pprAddr _ (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ] -pprAddr platform (AddrRegImm r1 imm) = hcat [ pprImm platform imm, char '(', pprReg r1, char ')' ] +pprAddr platform (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg platform r1, char ')' ] +pprAddr platform (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg platform r1, char ')' ] +pprAddr platform (AddrRegImm r1 imm) = hcat [ pprImm platform imm, char '(', pprReg platform r1, char ')' ] pprSectionHeader :: Section -> Doc @@ -363,7 +357,7 @@ pprInstr _ (SPILL reg slot) = hcat [ ptext (sLit "\tSPILL"), char '\t', - pprReg reg, + pprReg platform reg, comma, ptext (sLit "SLOT") <> parens (int slot)] @@ -373,7 +367,7 @@ pprInstr _ (RELOAD slot reg) char '\t', ptext (sLit "SLOT") <> parens (int slot), comma, - pprReg reg] + pprReg platform reg] -} pprInstr platform (LD sz reg addr) = hcat [ @@ -390,7 +384,7 @@ pprInstr platform (LD sz reg addr) = hcat [ case addr of AddrRegImm _ _ -> empty AddrRegReg _ _ -> char 'x', char '\t', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprAddr platform addr ] @@ -408,7 +402,7 @@ pprInstr platform (LA sz reg addr) = hcat [ case addr of AddrRegImm _ _ -> empty AddrRegReg _ _ -> char 'x', char '\t', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprAddr platform addr ] @@ -419,7 +413,7 @@ pprInstr platform (ST sz reg addr) = hcat [ case addr of AddrRegImm _ _ -> empty AddrRegReg _ _ -> char 'x', char '\t', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprAddr platform addr ] @@ -430,7 +424,7 @@ pprInstr platform (STU sz reg addr) = hcat [ ptext (sLit "u\t"), case addr of AddrRegImm _ _ -> empty AddrRegReg _ _ -> char 'x', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprAddr platform addr ] @@ -438,7 +432,7 @@ pprInstr platform (LIS reg imm) = hcat [ char '\t', ptext (sLit "lis"), char '\t', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprImm platform imm ] @@ -446,7 +440,7 @@ pprInstr platform (LI reg imm) = hcat [ char '\t', ptext (sLit "li"), char '\t', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprImm platform imm ] @@ -458,15 +452,15 @@ pprInstr platform (MR reg1 reg2) RcInteger -> ptext (sLit "mr") _ -> ptext (sLit "fmr"), char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2 + pprReg platform reg2 ] pprInstr platform (CMP sz reg ri) = hcat [ char '\t', op, char '\t', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprRI platform ri ] @@ -482,7 +476,7 @@ pprInstr platform (CMPL sz reg ri) = hcat [ char '\t', op, char '\t', - pprReg reg, + pprReg platform reg, ptext (sLit ", "), pprRI platform ri ] @@ -523,11 +517,11 @@ pprInstr platform (JMP lbl) = hcat [ -- an alias for b that takes a CLabel pprCLabel_asm platform lbl ] -pprInstr _ (MTCTR reg) = hcat [ +pprInstr platform (MTCTR reg) = hcat [ char '\t', ptext (sLit "mtctr"), char '\t', - pprReg reg + pprReg platform reg ] pprInstr _ (BCTR _ _) = hcat [ char '\t', @@ -546,9 +540,9 @@ pprInstr platform (ADDIS reg1 reg2 imm) = hcat [ char '\t', ptext (sLit "addis"), char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2, + pprReg platform reg2, ptext (sLit ", "), pprImm platform imm ] @@ -561,13 +555,13 @@ pprInstr platform (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic platform (sLit "mull pprInstr platform (DIVW reg1 reg2 reg3) = pprLogic platform (sLit "divw") reg1 reg2 (RIReg reg3) pprInstr platform (DIVWU reg1 reg2 reg3) = pprLogic platform (sLit "divwu") reg1 reg2 (RIReg reg3) -pprInstr _ (MULLW_MayOflo reg1 reg2 reg3) = vcat [ - hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "), - pprReg reg2, ptext (sLit ", "), - pprReg reg3 ], - hcat [ ptext (sLit "\tmfxer\t"), pprReg reg1 ], - hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "), - pprReg reg1, ptext (sLit ", "), +pprInstr platform (MULLW_MayOflo reg1 reg2 reg3) = vcat [ + hcat [ ptext (sLit "\tmullwo\t"), pprReg platform reg1, ptext (sLit ", "), + pprReg platform reg2, ptext (sLit ", "), + pprReg platform reg3 ], + hcat [ ptext (sLit "\tmfxer\t"), pprReg platform reg1 ], + hcat [ ptext (sLit "\trlwinm\t"), pprReg platform reg1, ptext (sLit ", "), + pprReg platform reg1, ptext (sLit ", "), ptext (sLit "2, 31, 31") ] ] @@ -577,9 +571,9 @@ pprInstr platform (AND reg1 reg2 (RIImm imm)) = hcat [ char '\t', ptext (sLit "andi."), char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2, + pprReg platform reg2, ptext (sLit ", "), pprImm platform imm ] @@ -592,34 +586,34 @@ pprInstr platform (XORIS reg1 reg2 imm) = hcat [ char '\t', ptext (sLit "xoris"), char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2, + pprReg platform reg2, ptext (sLit ", "), pprImm platform imm ] -pprInstr _ (EXTS sz reg1 reg2) = hcat [ +pprInstr platform (EXTS sz reg1 reg2) = hcat [ char '\t', ptext (sLit "exts"), pprSize sz, char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2 + pprReg platform reg2 ] -pprInstr _ (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2 -pprInstr _ (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2 +pprInstr platform (NEG reg1 reg2) = pprUnary platform (sLit "neg") reg1 reg2 +pprInstr platform (NOT reg1 reg2) = pprUnary platform (sLit "not") reg1 reg2 pprInstr platform (SLW reg1 reg2 ri) = pprLogic platform (sLit "slw") reg1 reg2 (limitShiftRI ri) pprInstr platform (SRW reg1 reg2 ri) = pprLogic platform (sLit "srw") reg1 reg2 (limitShiftRI ri) pprInstr platform (SRAW reg1 reg2 ri) = pprLogic platform (sLit "sraw") reg1 reg2 (limitShiftRI ri) -pprInstr _ (RLWINM reg1 reg2 sh mb me) = hcat [ +pprInstr platform (RLWINM reg1 reg2 sh mb me) = hcat [ ptext (sLit "\trlwinm\t"), - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2, + pprReg platform reg2, ptext (sLit ", "), int sh, ptext (sLit ", "), @@ -628,25 +622,25 @@ pprInstr _ (RLWINM reg1 reg2 sh mb me) = hcat [ int me ] -pprInstr _ (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3 -pprInstr _ (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3 -pprInstr _ (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3 -pprInstr _ (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3 -pprInstr _ (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2 +pprInstr platform (FADD sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fadd") sz reg1 reg2 reg3 +pprInstr platform (FSUB sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fsub") sz reg1 reg2 reg3 +pprInstr platform (FMUL sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fmul") sz reg1 reg2 reg3 +pprInstr platform (FDIV sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fdiv") sz reg1 reg2 reg3 +pprInstr platform (FNEG reg1 reg2) = pprUnary platform (sLit "fneg") reg1 reg2 -pprInstr _ (FCMP reg1 reg2) = hcat [ +pprInstr platform (FCMP reg1 reg2) = hcat [ char '\t', ptext (sLit "fcmpu\tcr0, "), -- Note: we're using fcmpu, not fcmpo -- The difference is with fcmpo, compare with NaN is an invalid operation. -- We don't handle invalid fp ops, so we don't care - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2 + pprReg platform reg2 ] -pprInstr _ (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2 -pprInstr _ (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2 +pprInstr platform (FCTIWZ reg1 reg2) = pprUnary platform (sLit "fctiwz") reg1 reg2 +pprInstr platform (FRSP reg1 reg2) = pprUnary platform (sLit "frsp") reg1 reg2 pprInstr _ (CRNOR dst src1 src2) = hcat [ ptext (sLit "\tcrnor\t"), @@ -657,23 +651,23 @@ pprInstr _ (CRNOR dst src1 src2) = hcat [ int src2 ] -pprInstr _ (MFCR reg) = hcat [ +pprInstr platform (MFCR reg) = hcat [ char '\t', ptext (sLit "mfcr"), char '\t', - pprReg reg + pprReg platform reg ] -pprInstr _ (MFLR reg) = hcat [ +pprInstr platform (MFLR reg) = hcat [ char '\t', ptext (sLit "mflr"), char '\t', - pprReg reg + pprReg platform reg ] -pprInstr _ (FETCHPC reg) = vcat [ +pprInstr platform (FETCHPC reg) = vcat [ ptext (sLit "\tbcl\t20,31,1f"), - hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ] + hcat [ ptext (sLit "1:\tmflr\t"), pprReg platform reg ] ] pprInstr _ LWSYNC = ptext (sLit "\tlwsync") @@ -689,40 +683,40 @@ pprLogic platform op reg1 reg2 ri = hcat [ RIReg _ -> empty RIImm _ -> char 'i', char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2, + pprReg platform reg2, ptext (sLit ", "), pprRI platform ri ] -pprUnary :: LitString -> Reg -> Reg -> Doc -pprUnary op reg1 reg2 = hcat [ +pprUnary :: Platform -> LitString -> Reg -> Reg -> Doc +pprUnary platform op reg1 reg2 = hcat [ char '\t', ptext op, char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2 + pprReg platform reg2 ] -pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> Doc -pprBinaryF op sz reg1 reg2 reg3 = hcat [ +pprBinaryF :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> Doc +pprBinaryF platform op sz reg1 reg2 reg3 = hcat [ char '\t', ptext op, pprFSize sz, char '\t', - pprReg reg1, + pprReg platform reg1, ptext (sLit ", "), - pprReg reg2, + pprReg platform reg2, ptext (sLit ", "), - pprReg reg3 + pprReg platform reg3 ] pprRI :: Platform -> RI -> Doc -pprRI _ (RIReg r) = pprReg r +pprRI platform (RIReg r) = pprReg platform r pprRI platform (RIImm r) = pprImm platform r -- cgit v1.2.1