Remove half the CPP from nativeGen/PPC/Ppr.hs

1 files changed, 120 insertions, 126 deletions

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