diff options
author | Ian Lynagh <igloo@earth.li> | 2012-07-18 19:55:36 +0100 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2012-07-18 19:55:36 +0100 |
commit | e0d54c7d432f3309336e3ed912ea14f06f8c9872 (patch) | |
tree | 445b494f8b43309fb73523ff2fc5b04a05b991eb /compiler/nativeGen | |
parent | 2d969ff971eab7d847c5870c8825409cbcf959b4 (diff) | |
download | haskell-e0d54c7d432f3309336e3ed912ea14f06f8c9872.tar.gz |
Remove most of the redundant Platform argument passing in nativeGen/X86/Ppr.hs
Diffstat (limited to 'compiler/nativeGen')
-rw-r--r-- | compiler/nativeGen/X86/Ppr.hs | 661 |
1 files changed, 334 insertions, 327 deletions
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 6e8320471d..1821baf54e 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -52,25 +52,25 @@ pprNatCmmDecl platform (CmmData section dats) = pprSectionHeader platform section $$ pprDatas platform dats -- special case for split markers: -pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph [])) = pprLabel platform lbl +pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl -- special case for code without info table: pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph blocks)) = pprSectionHeader platform Text $$ - pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed - vcat (map (pprBasicBlock platform) blocks) $$ + pprLabel lbl $$ -- blocks guaranteed not null, so label needed + vcat (map pprBasicBlock blocks) $$ pprSizeDecl platform lbl pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = pprSectionHeader platform Text $$ ( (if platformHasSubsectionsViaSymbols platform - then pprCLabel platform (mkDeadStripPreventer info_lbl) <> char ':' + then ppr (mkDeadStripPreventer info_lbl) <> char ':' else empty) $$ vcat (map (pprData platform) info) $$ - pprLabel platform info_lbl + pprLabel info_lbl ) $$ - vcat (map (pprBasicBlock platform) blocks) $$ + vcat (map pprBasicBlock blocks) $$ -- above: Even the first block gets a label, because with branch-chain -- elimination, it might be the target of a goto. (if platformHasSubsectionsViaSymbols platform @@ -82,9 +82,9 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG -- so that the linker will not think it is unreferenced and dead-strip -- it. That's why the label is called a DeadStripPreventer (_dsp). text "\t.long " - <+> pprCLabel platform info_lbl + <+> ppr info_lbl <+> char '-' - <+> pprCLabel platform (mkDeadStripPreventer info_lbl) + <+> ppr (mkDeadStripPreventer info_lbl) else empty) $$ pprSizeDecl platform info_lbl @@ -92,19 +92,19 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG pprSizeDecl :: Platform -> CLabel -> SDoc pprSizeDecl platform lbl | osElfTarget (platformOS platform) = - ptext (sLit "\t.size") <+> pprCLabel platform lbl - <> ptext (sLit ", .-") <> pprCLabel platform lbl + ptext (sLit "\t.size") <+> ppr lbl + <> ptext (sLit ", .-") <> ppr lbl | otherwise = empty -pprBasicBlock :: Platform -> NatBasicBlock Instr -> SDoc -pprBasicBlock platform (BasicBlock blockid instrs) = - pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$ - vcat (map (pprInstr platform) instrs) +pprBasicBlock :: NatBasicBlock Instr -> SDoc +pprBasicBlock (BasicBlock blockid instrs) = + pprLabel (mkAsmTempLabel (getUnique blockid)) $$ + vcat (map pprInstr instrs) pprDatas :: Platform -> (Alignment, CmmStatics) -> SDoc pprDatas platform (align, (Statics lbl dats)) - = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData platform) dats) + = vcat (pprAlign platform align : pprLabel lbl : map (pprData platform) dats) -- TODO: could remove if align == 1 pprData :: Platform -> CmmStatic -> SDoc @@ -116,22 +116,22 @@ pprData platform (CmmUninitialised bytes) pprData platform (CmmStaticLit lit) = pprDataItem platform lit -pprGloblDecl :: Platform -> CLabel -> SDoc -pprGloblDecl platform lbl +pprGloblDecl :: CLabel -> SDoc +pprGloblDecl lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = ptext (sLit ".globl ") <> pprCLabel platform lbl + | otherwise = ptext (sLit ".globl ") <> ppr lbl -pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc -pprTypeAndSizeDecl platform lbl - | osElfTarget (platformOS platform) && externallyVisibleCLabel lbl - = ptext (sLit ".type ") <> - pprCLabel platform lbl <> ptext (sLit ", @object") - | otherwise = empty +pprTypeAndSizeDecl :: CLabel -> SDoc +pprTypeAndSizeDecl lbl + = sdocWithPlatform $ \platform -> + if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl + then ptext (sLit ".type ") <> ppr lbl <> ptext (sLit ", @object") + else empty -pprLabel :: Platform -> CLabel -> SDoc -pprLabel platform lbl = pprGloblDecl platform lbl - $$ pprTypeAndSizeDecl platform lbl - $$ (pprCLabel platform lbl <> char ':') +pprLabel :: CLabel -> SDoc +pprLabel lbl = pprGloblDecl lbl + $$ pprTypeAndSizeDecl lbl + $$ (ppr lbl <> char ':') pprASCII :: [Word8] -> SDoc @@ -160,13 +160,14 @@ pprAlign platform bytes -- pprInstr: print an 'Instr' instance Outputable Instr where - ppr instr = sdocWithPlatform $ \platform -> pprInstr platform instr + ppr instr = pprInstr instr -pprReg :: Platform -> Size -> Reg -> SDoc -pprReg platform s r +pprReg :: Size -> Reg -> SDoc +pprReg s r = case r of RegReal (RealRegSingle i) -> + sdocWithPlatform $ \platform -> if target32Bit platform then ppr32_reg_no s i else ppr64_reg_no s i RegReal (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch" @@ -313,25 +314,25 @@ pprCond c ALWAYS -> sLit "mp"}) -pprImm :: Platform -> Imm -> SDoc -pprImm _ (ImmInt i) = int i -pprImm _ (ImmInteger i) = integer i -pprImm platform (ImmCLbl l) = pprCLabel platform l -pprImm platform (ImmIndex l i) = pprCLabel platform l <> char '+' <> int i -pprImm _ (ImmLit s) = s +pprImm :: Imm -> SDoc +pprImm (ImmInt i) = int i +pprImm (ImmInteger i) = integer i +pprImm (ImmCLbl l) = ppr l +pprImm (ImmIndex l i) = ppr l <> char '+' <> int i +pprImm (ImmLit s) = s -pprImm _ (ImmFloat _) = ptext (sLit "naughty float immediate") -pprImm _ (ImmDouble _) = ptext (sLit "naughty double immediate") +pprImm (ImmFloat _) = ptext (sLit "naughty float immediate") +pprImm (ImmDouble _) = ptext (sLit "naughty double immediate") -pprImm platform (ImmConstantSum a b) = pprImm platform a <> char '+' <> pprImm platform b -pprImm platform (ImmConstantDiff a b) = pprImm platform a <> char '-' - <> lparen <> pprImm platform b <> rparen +pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b +pprImm (ImmConstantDiff a b) = pprImm a <> char '-' + <> lparen <> pprImm b <> rparen -pprAddr :: Platform -> AddrMode -> SDoc -pprAddr platform (ImmAddr imm off) - = let pp_imm = pprImm platform imm +pprAddr :: AddrMode -> SDoc +pprAddr (ImmAddr imm off) + = let pp_imm = pprImm imm in if (off == 0) then pp_imm @@ -340,11 +341,12 @@ pprAddr platform (ImmAddr imm off) else pp_imm <> char '+' <> int off -pprAddr platform (AddrBaseIndex base index displacement) - = let +pprAddr (AddrBaseIndex base index displacement) + = sdocWithPlatform $ \platform -> + let pp_disp = ppr_disp displacement pp_off p = pp_disp <> char '(' <> p <> char ')' - pp_reg r = pprReg platform (archWordSize (target32Bit platform)) r + pp_reg r = pprReg (archWordSize (target32Bit platform)) r in case (base, index) of (EABaseNone, EAIndexNone) -> pp_disp @@ -357,7 +359,7 @@ pprAddr platform (AddrBaseIndex base index displacement) where ppr_disp (ImmInt 0) = empty - ppr_disp imm = pprImm platform imm + ppr_disp imm = pprImm imm pprSectionHeader :: Platform -> Section -> SDoc @@ -412,17 +414,17 @@ pprDataItem platform lit imm = litToImm lit -- These seem to be common: - ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm platform imm] - ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm platform imm] - ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm platform imm] + ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm] + ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm imm] + ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm] ppr_item FF32 (CmmFloat r _) = let bs = floatToBytes (fromRational r) - in map (\b -> ptext (sLit "\t.byte\t") <> pprImm platform (ImmInt b)) bs + in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs ppr_item FF64 (CmmFloat r _) = let bs = doubleToBytes (fromRational r) - in map (\b -> ptext (sLit "\t.byte\t") <> pprImm platform (ImmInt b)) bs + in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs ppr_item II64 _ = case platformOS platform of @@ -437,10 +439,10 @@ pprDataItem platform lit (fromIntegral (x `shiftR` 32) :: Word32))] _ -> panic "X86.Ppr.ppr_item: no match for II64" | otherwise -> - [ptext (sLit "\t.quad\t") <> pprImm platform imm] + [ptext (sLit "\t.quad\t") <> pprImm imm] _ | target32Bit platform -> - [ptext (sLit "\t.quad\t") <> pprImm platform imm] + [ptext (sLit "\t.quad\t") <> pprImm imm] | otherwise -> -- x86_64: binutils can't handle the R_X86_64_PC64 -- relocation type, which means we can't do @@ -455,33 +457,33 @@ pprDataItem platform lit case lit of -- A relative relocation: CmmLabelDiffOff _ _ _ -> - [ptext (sLit "\t.long\t") <> pprImm platform imm, + [ptext (sLit "\t.long\t") <> pprImm imm, ptext (sLit "\t.long\t0")] _ -> - [ptext (sLit "\t.quad\t") <> pprImm platform imm] + [ptext (sLit "\t.quad\t") <> pprImm imm] ppr_item _ _ = panic "X86.Ppr.ppr_item: no match" -pprInstr :: Platform -> Instr -> SDoc +pprInstr :: Instr -> SDoc -pprInstr _ (COMMENT _) = empty -- nuke 'em +pprInstr (COMMENT _) = empty -- nuke 'em {- -pprInstr _ (COMMENT s) = ptext (sLit "# ") <> ftext s +pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s -} -pprInstr platform (DELTA d) - = pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d))) +pprInstr (DELTA d) + = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) -pprInstr _ (NEWBLOCK _) +pprInstr (NEWBLOCK _) = panic "PprMach.pprInstr: NEWBLOCK" -pprInstr _ (LDATA _ _) +pprInstr (LDATA _ _) = panic "PprMach.pprInstr: LDATA" {- -pprInstr _ (SPILL reg slot) +pprInstr (SPILL reg slot) = hcat [ ptext (sLit "\tSPILL"), char ' ', @@ -489,7 +491,7 @@ pprInstr _ (SPILL reg slot) comma, ptext (sLit "SLOT") <> parens (int slot)] -pprInstr _ (RELOAD slot reg) +pprInstr (RELOAD slot reg) = hcat [ ptext (sLit "\tRELOAD"), char ' ', @@ -498,48 +500,50 @@ pprInstr _ (RELOAD slot reg) pprUserReg reg] -} -pprInstr platform (MOV size src dst) - = pprSizeOpOp platform (sLit "mov") size src dst +pprInstr (MOV size src dst) + = pprSizeOpOp (sLit "mov") size src dst -pprInstr platform (MOVZxL II32 src dst) = pprSizeOpOp platform (sLit "mov") II32 src dst +pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple -- movl. But we represent it as a MOVZxL instruction, because -- the reg alloc would tend to throw away a plain reg-to-reg -- move, and we still want it to do that. -pprInstr platform (MOVZxL sizes src dst) = pprSizeOpOpCoerce platform (sLit "movz") sizes II32 src dst +pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst -- zero-extension only needs to extend to 32 bits: on x86_64, -- the remaining zero-extension to 64 bits is automatic, and the 32-bit -- instruction is shorter. -pprInstr platform (MOVSxL sizes src dst) = pprSizeOpOpCoerce platform (sLit "movs") sizes (archWordSize (target32Bit platform)) src dst +pprInstr (MOVSxL sizes src dst) + = sdocWithPlatform $ \platform -> + pprSizeOpOpCoerce (sLit "movs") sizes (archWordSize (target32Bit platform)) src dst -- here we do some patching, since the physical registers are only set late -- in the code generation. -pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) | reg1 == reg3 - = pprSizeOpOp platform (sLit "add") size (OpReg reg2) dst + = pprSizeOpOp (sLit "add") size (OpReg reg2) dst -pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3)) | reg2 == reg3 - = pprSizeOpOp platform (sLit "add") size (OpReg reg1) dst + = pprSizeOpOp (sLit "add") size (OpReg reg1) dst -pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3)) | reg1 == reg3 - = pprInstr platform (ADD size (OpImm displ) dst) + = pprInstr (ADD size (OpImm displ) dst) -pprInstr platform (LEA size src dst) = pprSizeOpOp platform (sLit "lea") size src dst +pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst -pprInstr platform (ADD size (OpImm (ImmInt (-1))) dst) - = pprSizeOp platform (sLit "dec") size dst -pprInstr platform (ADD size (OpImm (ImmInt 1)) dst) - = pprSizeOp platform (sLit "inc") size dst -pprInstr platform (ADD size src dst) - = pprSizeOpOp platform (sLit "add") size src dst -pprInstr platform (ADC size src dst) - = pprSizeOpOp platform (sLit "adc") size src dst -pprInstr platform (SUB size src dst) = pprSizeOpOp platform (sLit "sub") size src dst -pprInstr platform (IMUL size op1 op2) = pprSizeOpOp platform (sLit "imul") size op1 op2 +pprInstr (ADD size (OpImm (ImmInt (-1))) dst) + = pprSizeOp (sLit "dec") size dst +pprInstr (ADD size (OpImm (ImmInt 1)) dst) + = pprSizeOp (sLit "inc") size dst +pprInstr (ADD size src dst) + = pprSizeOpOp (sLit "add") size src dst +pprInstr (ADC size src dst) + = pprSizeOpOp (sLit "adc") size src dst +pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst +pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2 {- A hack. The Intel documentation says that "The two and three operand forms [of IMUL] may also be used with unsigned operands @@ -548,27 +552,27 @@ pprInstr platform (IMUL size op1 op2) = pprSizeOpOp platform (sLit "imul") size however, cannot be used to determine if the upper half of the result is non-zero." So there. -} -pprInstr platform (AND size src dst) = pprSizeOpOp platform (sLit "and") size src dst -pprInstr platform (OR size src dst) = pprSizeOpOp platform (sLit "or") size src dst +pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst +pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst -pprInstr platform (XOR FF32 src dst) = pprOpOp platform (sLit "xorps") FF32 src dst -pprInstr platform (XOR FF64 src dst) = pprOpOp platform (sLit "xorpd") FF64 src dst -pprInstr platform (XOR size src dst) = pprSizeOpOp platform (sLit "xor") size src dst +pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst +pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst +pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst -pprInstr platform (POPCNT size src dst) = pprOpOp platform (sLit "popcnt") size src (OpReg dst) +pprInstr (POPCNT size src dst) = pprOpOp (sLit "popcnt") size src (OpReg dst) -pprInstr platform (NOT size op) = pprSizeOp platform (sLit "not") size op -pprInstr platform (NEGI size op) = pprSizeOp platform (sLit "neg") size op +pprInstr (NOT size op) = pprSizeOp (sLit "not") size op +pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op -pprInstr platform (SHL size src dst) = pprShift platform (sLit "shl") size src dst -pprInstr platform (SAR size src dst) = pprShift platform (sLit "sar") size src dst -pprInstr platform (SHR size src dst) = pprShift platform (sLit "shr") size src dst +pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst +pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst +pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst -pprInstr platform (BT size imm src) = pprSizeImmOp platform (sLit "bt") size imm src +pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src -pprInstr platform (CMP size src dst) - | is_float size = pprSizeOpOp platform (sLit "ucomi") size src dst -- SSE2 - | otherwise = pprSizeOpOp platform (sLit "cmp") size src dst +pprInstr (CMP size src dst) + | is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2 + | otherwise = pprSizeOpOp (sLit "cmp") size src dst where -- This predicate is needed here and nowhere else is_float FF32 = True @@ -576,64 +580,66 @@ pprInstr platform (CMP size src dst) is_float FF80 = True is_float _ = False -pprInstr platform (TEST size src dst) = pprSizeOpOp platform (sLit "test") size src dst -pprInstr platform (PUSH size op) = pprSizeOp platform (sLit "push") size op -pprInstr platform (POP size op) = pprSizeOp platform (sLit "pop") size op +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 -- both unused (SDM): -- pprInstr PUSHA = ptext (sLit "\tpushal") -- pprInstr POPA = ptext (sLit "\tpopal") -pprInstr _ NOP = ptext (sLit "\tnop") -pprInstr _ (CLTD II32) = ptext (sLit "\tcltd") -pprInstr _ (CLTD II64) = ptext (sLit "\tcqto") +pprInstr NOP = ptext (sLit "\tnop") +pprInstr (CLTD II32) = ptext (sLit "\tcltd") +pprInstr (CLTD II64) = ptext (sLit "\tcqto") -pprInstr platform (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand platform II8 op) +pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op) -pprInstr platform (JXX cond blockid) - = pprCondInstr (sLit "j") cond (pprCLabel platform lab) +pprInstr (JXX cond blockid) + = pprCondInstr (sLit "j") cond (ppr lab) where lab = mkAsmTempLabel (getUnique blockid) -pprInstr platform (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm platform imm) +pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm) -pprInstr platform (JMP (OpImm imm) _) = (<>) (ptext (sLit "\tjmp ")) (pprImm platform imm) -pprInstr platform (JMP op _) = (<>) (ptext (sLit "\tjmp *")) (pprOperand platform (archWordSize (target32Bit platform)) op) -pprInstr platform (JMP_TBL op _ _ _) = pprInstr platform (JMP op []) -pprInstr platform (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm platform imm) -pprInstr platform (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg platform (archWordSize (target32Bit platform)) reg) +pprInstr (JMP (OpImm imm) _) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm) +pprInstr (JMP op _) = sdocWithPlatform $ \platform -> + (<>) (ptext (sLit "\tjmp *")) (pprOperand (archWordSize (target32Bit platform)) op) +pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op []) +pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm) +pprInstr (CALL (Right reg) _) = sdocWithPlatform $ \platform -> + (<>) (ptext (sLit "\tcall *")) (pprReg (archWordSize (target32Bit platform)) reg) -pprInstr platform (IDIV sz op) = pprSizeOp platform (sLit "idiv") sz op -pprInstr platform (DIV sz op) = pprSizeOp platform (sLit "div") sz op -pprInstr platform (IMUL2 sz op) = pprSizeOp platform (sLit "imul") sz op +pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op +pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op +pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op -- x86_64 only -pprInstr platform (MUL size op1 op2) = pprSizeOpOp platform (sLit "mul") size op1 op2 -pprInstr platform (MUL2 size op) = pprSizeOp platform (sLit "mul") size op +pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2 +pprInstr (MUL2 size op) = pprSizeOp (sLit "mul") size op -pprInstr platform (FDIV size op1 op2) = pprSizeOpOp platform (sLit "div") size op1 op2 +pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2 -pprInstr platform (CVTSS2SD from to) = pprRegReg platform (sLit "cvtss2sd") from to -pprInstr platform (CVTSD2SS from to) = pprRegReg platform (sLit "cvtsd2ss") from to -pprInstr platform (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg platform (sLit "cvttss2si") FF32 sz from to -pprInstr platform (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg platform (sLit "cvttsd2si") FF64 sz from to -pprInstr platform (CVTSI2SS sz from to) = pprSizeOpReg platform (sLit "cvtsi2ss") sz from to -pprInstr platform (CVTSI2SD sz from to) = pprSizeOpReg platform (sLit "cvtsi2sd") sz from to +pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to +pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to +pprInstr (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttss2si") FF32 sz from to +pprInstr (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttsd2si") FF64 sz from to +pprInstr (CVTSI2SS sz from to) = pprSizeOpReg (sLit "cvtsi2ss") sz from to +pprInstr (CVTSI2SD sz from to) = pprSizeOpReg (sLit "cvtsi2sd") sz from to -- FETCHGOT for PIC on ELF platforms -pprInstr platform (FETCHGOT reg) +pprInstr (FETCHGOT reg) = vcat [ ptext (sLit "\tcall 1f"), - hcat [ ptext (sLit "1:\tpopl\t"), pprReg platform II32 reg ], + hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ], hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "), - pprReg platform II32 reg ] + pprReg II32 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 platform (FETCHPC reg) +pprInstr (FETCHPC reg) = vcat [ ptext (sLit "\tcall 1f"), - hcat [ ptext (sLit "1:\tpopl\t"), pprReg platform II32 reg ] + hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ] ] @@ -643,36 +649,36 @@ pprInstr platform (FETCHPC reg) -- 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 platform g@(GMOV src dst) +pprInstr g@(GMOV src dst) | src == dst = empty | otherwise - = pprG platform g (hcat [gtab, gpush src 0, gsemi, gpop dst 1]) + = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1]) -- GLD sz addr dst ==> FLDsz addr ; FSTP (dst+1) -pprInstr platform g@(GLD sz addr dst) - = pprG platform g (hcat [gtab, text "fld", pprSize_x87 sz, gsp, - pprAddr platform addr, gsemi, gpop dst 1]) +pprInstr g@(GLD sz addr dst) + = pprG g (hcat [gtab, text "fld", pprSize_x87 sz, gsp, + pprAddr addr, gsemi, gpop dst 1]) -- GST sz src addr ==> FLD dst ; FSTPsz addr -pprInstr platform g@(GST sz src addr) +pprInstr g@(GST sz src addr) | src == fake0 && sz /= FF80 -- fstt instruction doesn't exist - = pprG platform g (hcat [gtab, - text "fst", pprSize_x87 sz, gsp, pprAddr platform addr]) + = pprG g (hcat [gtab, + text "fst", pprSize_x87 sz, gsp, pprAddr addr]) | otherwise - = pprG platform g (hcat [gtab, gpush src 0, gsemi, - text "fstp", pprSize_x87 sz, gsp, pprAddr platform addr]) + = pprG g (hcat [gtab, gpush src 0, gsemi, + text "fstp", pprSize_x87 sz, gsp, pprAddr addr]) -pprInstr platform g@(GLDZ dst) - = pprG platform g (hcat [gtab, text "fldz ; ", gpop dst 1]) -pprInstr platform g@(GLD1 dst) - = pprG platform g (hcat [gtab, text "fld1 ; ", gpop dst 1]) +pprInstr g@(GLDZ dst) + = pprG g (hcat [gtab, text "fldz ; ", gpop dst 1]) +pprInstr g@(GLD1 dst) + = pprG g (hcat [gtab, text "fld1 ; ", gpop dst 1]) -pprInstr platform (GFTOI src dst) - = pprInstr platform (GDTOI src dst) +pprInstr (GFTOI src dst) + = pprInstr (GDTOI src dst) -pprInstr platform g@(GDTOI src dst) - = pprG platform g (vcat [ +pprInstr g@(GDTOI src dst) + = pprG g (vcat [ hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"], hcat [gtab, gpush src 0], hcat [gtab, text "movzwl 4(%esp), ", reg, @@ -683,20 +689,20 @@ pprInstr platform g@(GDTOI src dst) hcat [gtab, text "addl $8, %esp"] ]) where - reg = pprReg platform II32 dst + reg = pprReg II32 dst -pprInstr platform (GITOF src dst) - = pprInstr platform (GITOD src dst) +pprInstr (GITOF src dst) + = pprInstr (GITOD src dst) -pprInstr platform g@(GITOD src dst) - = pprG platform g (hcat [gtab, text "pushl ", pprReg platform II32 src, - text " ; fildl (%esp) ; ", - gpop dst 1, text " ; addl $4,%esp"]) +pprInstr g@(GITOD src dst) + = pprG g (hcat [gtab, text "pushl ", pprReg II32 src, + text " ; fildl (%esp) ; ", + gpop dst 1, text " ; addl $4,%esp"]) -pprInstr platform g@(GDTOF src dst) - = pprG platform g (vcat [gtab <> gpush src 0, - gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;", - gtab <> gpop dst 1]) +pprInstr g@(GDTOF src dst) + = pprG g (vcat [gtab <> gpush src 0, + gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;", + gtab <> gpop dst 1]) {- Gruesome swamp follows. If you're unfortunate enough to have ventured this far into the jungle AND you give a Rat's Ass (tm) what's going @@ -736,9 +742,9 @@ pprInstr platform g@(GDTOF src dst) decb %al -- if (incomparable || different) then (%al == 0, ZF=1) else (%al == 0xFF, ZF=0) -} -pprInstr platform g@(GCMP cond src1 src2) +pprInstr g@(GCMP cond src1 src2) | case cond of { NE -> True; _ -> False } - = pprG platform g (vcat [ + = pprG g (vcat [ hcat [gtab, text "pushl %eax ; ",gpush src1 0], hcat [gtab, text "fcomp ", greg src2 1, text "; fstsw %ax ; sahf ; setpe %ah"], @@ -746,7 +752,7 @@ pprInstr platform g@(GCMP cond src1 src2) text "orb %ah,%al ; decb %al ; popl %eax"] ]) | otherwise - = pprG platform g (vcat [ + = pprG g (vcat [ hcat [gtab, text "pushl %eax ; ",gpush src1 0], hcat [gtab, text "fcomp ", greg src2 1, text "; fstsw %ax ; sahf ; setpo %ah"], @@ -768,102 +774,101 @@ pprInstr platform g@(GCMP cond src1 src2) -- there should be no others -pprInstr platform g@(GABS _ src dst) - = pprG platform g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1]) +pprInstr g@(GABS _ src dst) + = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1]) -pprInstr platform g@(GNEG _ src dst) - = pprG platform g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1]) +pprInstr g@(GNEG _ src dst) + = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1]) -pprInstr platform g@(GSQRT sz src dst) - = pprG platform g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$ - hcat [gtab, gcoerceto sz, gpop dst 1]) +pprInstr g@(GSQRT sz src dst) + = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$ + hcat [gtab, gcoerceto sz, gpop dst 1]) -pprInstr platform g@(GSIN sz l1 l2 src dst) - = pprG platform g (pprTrigOp platform "fsin" False l1 l2 src dst sz) +pprInstr g@(GSIN sz l1 l2 src dst) + = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz) -pprInstr platform g@(GCOS sz l1 l2 src dst) - = pprG platform g (pprTrigOp platform "fcos" False l1 l2 src dst sz) +pprInstr g@(GCOS sz l1 l2 src dst) + = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz) -pprInstr platform g@(GTAN sz l1 l2 src dst) - = pprG platform g (pprTrigOp platform "fptan" True l1 l2 src dst sz) +pprInstr g@(GTAN sz l1 l2 src dst) + = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz) -- In the translations for GADD, GMUL, GSUB and GDIV, -- the first two cases are mere optimisations. The otherwise clause -- generates correct code under all circumstances. -pprInstr platform g@(GADD _ src1 src2 dst) +pprInstr g@(GADD _ src1 src2 dst) | src1 == dst - = pprG platform g (text "\t#GADD-xxxcase1" $$ - hcat [gtab, gpush src2 0, - text " ; faddp %st(0),", greg src1 1]) + = pprG g (text "\t#GADD-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; faddp %st(0),", greg src1 1]) | src2 == dst - = pprG platform g (text "\t#GADD-xxxcase2" $$ - hcat [gtab, gpush src1 0, - text " ; faddp %st(0),", greg src2 1]) + = pprG g (text "\t#GADD-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; faddp %st(0),", greg src2 1]) | otherwise - = pprG platform g (hcat [gtab, gpush src1 0, - text " ; fadd ", greg src2 1, text ",%st(0)", - gsemi, gpop dst 1]) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fadd ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) -pprInstr platform g@(GMUL _ src1 src2 dst) +pprInstr g@(GMUL _ src1 src2 dst) | src1 == dst - = pprG platform g (text "\t#GMUL-xxxcase1" $$ - hcat [gtab, gpush src2 0, - text " ; fmulp %st(0),", greg src1 1]) + = pprG g (text "\t#GMUL-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; fmulp %st(0),", greg src1 1]) | src2 == dst - = pprG platform g (text "\t#GMUL-xxxcase2" $$ - hcat [gtab, gpush src1 0, - text " ; fmulp %st(0),", greg src2 1]) + = pprG g (text "\t#GMUL-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; fmulp %st(0),", greg src2 1]) | otherwise - = pprG platform g (hcat [gtab, gpush src1 0, - text " ; fmul ", greg src2 1, text ",%st(0)", - gsemi, gpop dst 1]) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fmul ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) -pprInstr platform g@(GSUB _ src1 src2 dst) +pprInstr g@(GSUB _ src1 src2 dst) | src1 == dst - = pprG platform g (text "\t#GSUB-xxxcase1" $$ - hcat [gtab, gpush src2 0, - text " ; fsubrp %st(0),", greg src1 1]) + = pprG g (text "\t#GSUB-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; fsubrp %st(0),", greg src1 1]) | src2 == dst - = pprG platform g (text "\t#GSUB-xxxcase2" $$ - hcat [gtab, gpush src1 0, - text " ; fsubp %st(0),", greg src2 1]) + = pprG g (text "\t#GSUB-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; fsubp %st(0),", greg src2 1]) | otherwise - = pprG platform g (hcat [gtab, gpush src1 0, - text " ; fsub ", greg src2 1, text ",%st(0)", - gsemi, gpop dst 1]) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fsub ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) -pprInstr platform g@(GDIV _ src1 src2 dst) +pprInstr g@(GDIV _ src1 src2 dst) | src1 == dst - = pprG platform g (text "\t#GDIV-xxxcase1" $$ - hcat [gtab, gpush src2 0, - text " ; fdivrp %st(0),", greg src1 1]) + = pprG g (text "\t#GDIV-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; fdivrp %st(0),", greg src1 1]) | src2 == dst - = pprG platform g (text "\t#GDIV-xxxcase2" $$ - hcat [gtab, gpush src1 0, - text " ; fdivp %st(0),", greg src2 1]) + = pprG g (text "\t#GDIV-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; fdivp %st(0),", greg src2 1]) | otherwise - = pprG platform g (hcat [gtab, gpush src1 0, - text " ; fdiv ", greg src2 1, text ",%st(0)", - gsemi, gpop dst 1]) + = pprG g (hcat [gtab, gpush src1 0, + text " ; fdiv ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) -pprInstr _ GFREE +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)") ] -pprInstr _ _ +pprInstr _ = panic "X86.Ppr.pprInstr: no match" -pprTrigOp :: Platform -> String -> Bool -> CLabel -> CLabel +pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Size -> SDoc -pprTrigOp platform - op -- fsin, fcos or fptan +pprTrigOp op -- fsin, fcos or fptan isTan -- we need a couple of extra steps if we're doing tan l1 l2 -- internal labels for us to use src dst sz @@ -877,7 +882,7 @@ pprTrigOp platform hcat [gtab, text "fnstsw %ax"] $$ hcat [gtab, text "test $0x400,%eax"] $$ -- If we were in bounds then jump to the end - hcat [gtab, text "je " <> pprCLabel platform l1] $$ + hcat [gtab, text "je " <> ppr l1] $$ -- Otherwise we need to shrink the value. Start by -- loading pi, doubleing it (by adding it to itself), -- and then swapping pi with the value, so the value we @@ -887,16 +892,16 @@ pprTrigOp platform hcat [gtab, text "fxch %st(1)"] $$ -- Now we have a loop in which we make the value smaller, -- see if it's small enough, and loop if not - (pprCLabel platform l2 <> char ':') $$ + (ppr l2 <> char ':') $$ hcat [gtab, text "fprem1"] $$ -- My Debian libc uses fstsw here for the tan code, but I can't -- see any reason why it should need to be different for tan. hcat [gtab, text "fnstsw %ax"] $$ hcat [gtab, text "test $0x400,%eax"] $$ - hcat [gtab, text "jne " <> pprCLabel platform l2] $$ + hcat [gtab, text "jne " <> ppr l2] $$ hcat [gtab, text "fstp %st(1)"] $$ hcat [gtab, text op] $$ - (pprCLabel platform l1 <> char ':') $$ + (ppr l1 <> char ':') $$ -- Pop the 1.0 tan gave us (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$ -- Restore %eax @@ -937,49 +942,49 @@ gregno (RegReal (RealRegSingle i)) = i gregno _ = --pprPanic "gregno" (ppr other) 999 -- bogus; only needed for debug printing -pprG :: Platform -> Instr -> SDoc -> SDoc -pprG platform fake actual - = (char '#' <> pprGInstr platform fake) $$ actual +pprG :: Instr -> SDoc -> SDoc +pprG fake actual + = (char '#' <> pprGInstr fake) $$ actual -pprGInstr :: Platform -> Instr -> SDoc -pprGInstr platform (GMOV src dst) = pprSizeRegReg platform (sLit "gmov") FF64 src dst -pprGInstr platform (GLD sz src dst) = pprSizeAddrReg platform (sLit "gld") sz src dst -pprGInstr platform (GST sz src dst) = pprSizeRegAddr platform (sLit "gst") sz src dst +pprGInstr :: Instr -> SDoc +pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 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 platform (GLDZ dst) = pprSizeReg platform (sLit "gldz") FF64 dst -pprGInstr platform (GLD1 dst) = pprSizeReg platform (sLit "gld1") FF64 dst +pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst +pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst -pprGInstr platform (GFTOI src dst) = pprSizeSizeRegReg platform (sLit "gftoi") FF32 II32 src dst -pprGInstr platform (GDTOI src dst) = pprSizeSizeRegReg platform (sLit "gdtoi") FF64 II32 src dst +pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst +pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst -pprGInstr platform (GITOF src dst) = pprSizeSizeRegReg platform (sLit "gitof") II32 FF32 src dst -pprGInstr platform (GITOD src dst) = pprSizeSizeRegReg platform (sLit "gitod") II32 FF64 src dst -pprGInstr platform (GDTOF src dst) = pprSizeSizeRegReg platform (sLit "gdtof") FF64 FF32 src dst +pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst +pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst +pprGInstr (GDTOF src dst) = pprSizeSizeRegReg (sLit "gdtof") FF64 FF32 src dst -pprGInstr platform (GCMP co src dst) = pprCondRegReg platform (sLit "gcmp_") FF64 co src dst -pprGInstr platform (GABS sz src dst) = pprSizeRegReg platform (sLit "gabs") sz src dst -pprGInstr platform (GNEG sz src dst) = pprSizeRegReg platform (sLit "gneg") sz src dst -pprGInstr platform (GSQRT sz src dst) = pprSizeRegReg platform (sLit "gsqrt") sz src dst -pprGInstr platform (GSIN sz _ _ src dst) = pprSizeRegReg platform (sLit "gsin") sz src dst -pprGInstr platform (GCOS sz _ _ src dst) = pprSizeRegReg platform (sLit "gcos") sz src dst -pprGInstr platform (GTAN sz _ _ src dst) = pprSizeRegReg platform (sLit "gtan") sz src dst +pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co 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 (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst +pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst +pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst -pprGInstr platform (GADD sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gadd") sz src1 src2 dst -pprGInstr platform (GSUB sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gsub") sz src1 src2 dst -pprGInstr platform (GMUL sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gmul") sz src1 src2 dst -pprGInstr platform (GDIV sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gdiv") sz src1 src2 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 -pprGInstr _ _ = panic "X86.Ppr.pprGInstr: no match" +pprGInstr _ = panic "X86.Ppr.pprGInstr: no match" -pprDollImm :: Platform -> Imm -> SDoc -pprDollImm platform i = ptext (sLit "$") <> pprImm platform i +pprDollImm :: Imm -> SDoc +pprDollImm i = ptext (sLit "$") <> pprImm i -pprOperand :: Platform -> Size -> Operand -> SDoc -pprOperand platform s (OpReg r) = pprReg platform s r -pprOperand platform _ (OpImm i) = pprDollImm platform i -pprOperand platform _ (OpAddr ea) = pprAddr platform ea +pprOperand :: Size -> Operand -> SDoc +pprOperand s (OpReg r) = pprReg s r +pprOperand _ (OpImm i) = pprDollImm i +pprOperand _ (OpAddr ea) = pprAddr ea pprMnemonic_ :: LitString -> SDoc @@ -992,164 +997,166 @@ pprMnemonic name size = char '\t' <> ptext name <> pprSize size <> space -pprSizeImmOp :: Platform -> LitString -> Size -> Imm -> Operand -> SDoc -pprSizeImmOp platform name size imm op1 +pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> SDoc +pprSizeImmOp name size imm op1 = hcat [ pprMnemonic name size, char '$', - pprImm platform imm, + pprImm imm, comma, - pprOperand platform size op1 + pprOperand size op1 ] -pprSizeOp :: Platform -> LitString -> Size -> Operand -> SDoc -pprSizeOp platform name size op1 +pprSizeOp :: LitString -> Size -> Operand -> SDoc +pprSizeOp name size op1 = hcat [ pprMnemonic name size, - pprOperand platform size op1 + pprOperand size op1 ] -pprSizeOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc -pprSizeOpOp platform name size op1 op2 +pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> SDoc +pprSizeOpOp name size op1 op2 = hcat [ pprMnemonic name size, - pprOperand platform size op1, + pprOperand size op1, comma, - pprOperand platform size op2 + pprOperand size op2 ] -pprOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc -pprOpOp platform name size op1 op2 +pprOpOp :: LitString -> Size -> Operand -> Operand -> SDoc +pprOpOp name size op1 op2 = hcat [ pprMnemonic_ name, - pprOperand platform size op1, + pprOperand size op1, comma, - pprOperand platform size op2 + pprOperand size op2 ] -pprSizeReg :: Platform -> LitString -> Size -> Reg -> SDoc -pprSizeReg platform name size reg1 +pprSizeReg :: LitString -> Size -> Reg -> SDoc +pprSizeReg name size reg1 = hcat [ pprMnemonic name size, - pprReg platform size reg1 + pprReg size reg1 ] -pprSizeRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> SDoc -pprSizeRegReg platform name size reg1 reg2 +pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> SDoc +pprSizeRegReg name size reg1 reg2 = hcat [ pprMnemonic name size, - pprReg platform size reg1, + pprReg size reg1, comma, - pprReg platform size reg2 + pprReg size reg2 ] -pprRegReg :: Platform -> LitString -> Reg -> Reg -> SDoc -pprRegReg platform name reg1 reg2 - = hcat [ +pprRegReg :: LitString -> Reg -> Reg -> SDoc +pprRegReg name reg1 reg2 + = sdocWithPlatform $ \platform -> + hcat [ pprMnemonic_ name, - pprReg platform (archWordSize (target32Bit platform)) reg1, + pprReg (archWordSize (target32Bit platform)) reg1, comma, - pprReg platform (archWordSize (target32Bit platform)) reg2 + pprReg (archWordSize (target32Bit platform)) reg2 ] -pprSizeOpReg :: Platform -> LitString -> Size -> Operand -> Reg -> SDoc -pprSizeOpReg platform name size op1 reg2 - = hcat [ +pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> SDoc +pprSizeOpReg name size op1 reg2 + = sdocWithPlatform $ \platform -> + hcat [ pprMnemonic name size, - pprOperand platform size op1, + pprOperand size op1, comma, - pprReg platform (archWordSize (target32Bit platform)) reg2 + pprReg (archWordSize (target32Bit platform)) reg2 ] -pprCondRegReg :: Platform -> LitString -> Size -> Cond -> Reg -> Reg -> SDoc -pprCondRegReg platform name size cond reg1 reg2 +pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> SDoc +pprCondRegReg name size cond reg1 reg2 = hcat [ char '\t', ptext name, pprCond cond, space, - pprReg platform size reg1, + pprReg size reg1, comma, - pprReg platform size reg2 + pprReg size reg2 ] -pprSizeSizeRegReg :: Platform -> LitString -> Size -> Size -> Reg -> Reg -> SDoc -pprSizeSizeRegReg platform name size1 size2 reg1 reg2 +pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> SDoc +pprSizeSizeRegReg name size1 size2 reg1 reg2 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space, - pprReg platform size1 reg1, + pprReg size1 reg1, comma, - pprReg platform size2 reg2 + pprReg size2 reg2 ] -pprSizeSizeOpReg :: Platform -> LitString -> Size -> Size -> Operand -> Reg -> SDoc -pprSizeSizeOpReg platform name size1 size2 op1 reg2 +pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> SDoc +pprSizeSizeOpReg name size1 size2 op1 reg2 = hcat [ pprMnemonic name size2, - pprOperand platform size1 op1, + pprOperand size1 op1, comma, - pprReg platform size2 reg2 + pprReg size2 reg2 ] -pprSizeRegRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> SDoc -pprSizeRegRegReg platform name size reg1 reg2 reg3 +pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc +pprSizeRegRegReg name size reg1 reg2 reg3 = hcat [ pprMnemonic name size, - pprReg platform size reg1, + pprReg size reg1, comma, - pprReg platform size reg2, + pprReg size reg2, comma, - pprReg platform size reg3 + pprReg size reg3 ] -pprSizeAddrReg :: Platform -> LitString -> Size -> AddrMode -> Reg -> SDoc -pprSizeAddrReg platform name size op dst +pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> SDoc +pprSizeAddrReg name size op dst = hcat [ pprMnemonic name size, - pprAddr platform op, + pprAddr op, comma, - pprReg platform size dst + pprReg size dst ] -pprSizeRegAddr :: Platform -> LitString -> Size -> Reg -> AddrMode -> SDoc -pprSizeRegAddr platform name size src op +pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> SDoc +pprSizeRegAddr name size src op = hcat [ pprMnemonic name size, - pprReg platform size src, + pprReg size src, comma, - pprAddr platform op + pprAddr op ] -pprShift :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc -pprShift platform name size src dest +pprShift :: LitString -> Size -> Operand -> Operand -> SDoc +pprShift name size src dest = hcat [ pprMnemonic name size, - pprOperand platform II8 src, -- src is 8-bit sized + pprOperand II8 src, -- src is 8-bit sized comma, - pprOperand platform size dest + pprOperand size dest ] -pprSizeOpOpCoerce :: Platform -> LitString -> Size -> Size -> Operand -> Operand -> SDoc -pprSizeOpOpCoerce platform name size1 size2 op1 op2 +pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> SDoc +pprSizeOpOpCoerce name size1 size2 op1 op2 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space, - pprOperand platform size1 op1, + pprOperand size1 op1, comma, - pprOperand platform size2 op2 + pprOperand size2 op2 ] |