X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.hs;fp=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=64ee5c6a1a20c4e6695afcb89d5ac1bc0025aef1;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=0a6b136ac54db9fa38ad3c01fe14c55d94ed4fb5;hpb=553e90d9a32ee1b1809430f260c401cc4169c6c7;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.hs similarity index 77% rename from ghc/compiler/nativeGen/PprMach.lhs rename to ghc/compiler/nativeGen/PprMach.hs index 0a6b136..64ee5c6 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.hs @@ -1,66 +1,109 @@ -% -% (c) The AQUA Project, Glasgow University, 1996-1998 -% -\section[PprMach]{Pretty-printing assembly language} +----------------------------------------------------------------------------- +-- +-- Pretty-printing assembly language +-- + -- (c) The University of Glasgow 1993-2004 + -- +----------------------------------------------------------------------------- -We start with the @pprXXX@s with some cross-platform commonality -(e.g., @pprReg@); we conclude with the no-commonality monster, -@pprInstr@. +-- We start with the @pprXXX@s with some cross-platform commonality +-- (e.g., 'pprReg'); we conclude with the no-commonality monster, +-- 'pprInstr'. -\begin{code} #include "nativeGen/NCG.h" -module PprMach ( pprInstr, pprSize, pprUserReg IF_OS_darwin(COMMA pprDyldSymbolStub, ) ) where +module PprMach ( + pprNatCmmTop, pprBasicBlock, + pprInstr, pprSize, pprUserReg, +#if darwin_TARGET_OS + pprDyldSymbolStub, +#endif + ) where + #include "HsVersions.h" +import Cmm +import MachOp ( MachRep(..) ) import MachRegs -- may differ per-platform -import MachMisc +import MachInstrs + +import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel, + labelDynamic, mkAsmTempLabel, entryLblToInfoLbl ) -import CLabel ( pprCLabel, externallyVisibleCLabel, labelDynamic ) -import Stix ( CodeSegment(..) ) import Panic ( panic ) +import Unique ( pprUnique ) import Pretty import FastString import qualified Outputable #if __GLASGOW_HASKELL__ >= 504 import Data.Array.ST -import Data.Word ( Word8, Word16 ) +import Data.Word ( Word8 ) #else import MutableArray -import Word ( Word16 ) #endif import MONAD_ST - import Char ( chr, ord ) -import Maybe ( isJust ) + +#if powerpc_TARGET_ARCH +import DATA_WORD(Word32) +import DATA_BITS +#endif + +-- ----------------------------------------------------------------------------- +-- Printing this stuff out asmSDoc d = Outputable.withPprStyleDoc ( Outputable.mkCodeStyle Outputable.AsmStyle) d pprCLabel_asm l = asmSDoc (pprCLabel l) -\end{code} -%************************************************************************ -%* * -\subsection{@pprReg@: print a @Reg@} -%* * -%************************************************************************ +pprNatCmmTop :: NatCmmTop -> Doc +pprNatCmmTop (CmmData section dats) = + pprSectionHeader section $$ vcat (map pprData dats) + + -- special case for split markers: +pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl + +pprNatCmmTop (CmmProc info lbl params blocks) = + pprSectionHeader Text $$ + (if not (null info) + then vcat (map pprData info) + $$ pprLabel (entryLblToInfoLbl lbl) + else empty) $$ + (case blocks of + [] -> empty + (BasicBlock _ instrs : rest) -> + (if null info then pprLabel lbl else empty) $$ + -- the first block doesn't get a label: + vcat (map pprInstr instrs) $$ + vcat (map pprBasicBlock rest)) + + +pprBasicBlock :: NatBasicBlock -> Doc +pprBasicBlock (BasicBlock (BlockId id) instrs) = + pprLabel (mkAsmTempLabel id) $$ + vcat (map pprInstr instrs) + +-- ----------------------------------------------------------------------------- +-- pprReg: print a 'Reg' + +-- For x86, the way we print a register name depends +-- on which bit of it we care about. Yurgh. -For x86, the way we print a register name depends -on which bit of it we care about. Yurgh. -\begin{code} pprUserReg :: Reg -> Doc -pprUserReg = pprReg IF_ARCH_i386(L,) +pprUserReg = pprReg IF_ARCH_i386(I32,) -pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc +pprReg :: IF_ARCH_i386(MachRep ->,) Reg -> Doc pprReg IF_ARCH_i386(s,) r = case r of RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i - VirtualRegI u -> text "%vI_" <> asmSDoc (pprVRegUnique u) - VirtualRegF u -> text "%vF_" <> asmSDoc (pprVRegUnique u) + VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u) + VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u) + VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u) + VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u) where #if alpha_TARGET_ARCH ppr_reg_no :: Int -> Doc @@ -102,12 +145,10 @@ pprReg IF_ARCH_i386(s,) r }) #endif #if i386_TARGET_ARCH - ppr_reg_no :: Size -> Int -> Doc - ppr_reg_no B = ppr_reg_byte - ppr_reg_no Bu = ppr_reg_byte - ppr_reg_no W = ppr_reg_word - ppr_reg_no Wu = ppr_reg_word - ppr_reg_no _ = ppr_reg_long + ppr_reg_no :: MachRep -> Int -> Doc + ppr_reg_no I8 = ppr_reg_byte + ppr_reg_no I16 = ppr_reg_word + ppr_reg_no _ = ppr_reg_long ppr_reg_byte i = ptext (case i of { @@ -222,16 +263,16 @@ pprReg IF_ARCH_i386(s,) r | otherwise = ptext SLIT("very naughty powerpc register") #endif #endif -\end{code} -%************************************************************************ -%* * -\subsection{@pprSize@: print a @Size@} -%* * -%************************************************************************ -\begin{code} +-- ----------------------------------------------------------------------------- +-- pprSize: print a 'Size' + +#if powerpc_TARGET_ARCH || i386_TARGET_ARCH +pprSize :: MachRep -> Doc +#else pprSize :: Size -> Doc +#endif pprSize x = ptext (case x of #if alpha_TARGET_ARCH @@ -248,15 +289,12 @@ pprSize x = ptext (case x of TF -> SLIT("t") #endif #if i386_TARGET_ARCH - B -> SLIT("b") - Bu -> SLIT("b") - W -> SLIT("w") - Wu -> SLIT("w") - L -> SLIT("l") - Lu -> SLIT("l") - F -> SLIT("s") - DF -> SLIT("l") - F80 -> SLIT("t") + I8 -> SLIT("b") + I16 -> SLIT("w") + I32 -> SLIT("l") + F32 -> SLIT("s") + F64 -> SLIT("l") + F80 -> SLIT("t") #endif #if sparc_TARGET_ARCH B -> SLIT("sb") @@ -278,24 +316,17 @@ pprStSize x = ptext (case x of DF -> SLIT("d") #endif #if powerpc_TARGET_ARCH - B -> SLIT("b") - Bu -> SLIT("b") - H -> SLIT("h") - Hu -> SLIT("h") - W -> SLIT("w") - F -> SLIT("fs") - DF -> SLIT("fd") + I8 -> SLIT("b") + I16 -> SLIT("h") + I32 -> SLIT("w") + F32 -> SLIT("fs") + F64 -> SLIT("fd") #endif ) -\end{code} -%************************************************************************ -%* * -\subsection{@pprCond@: print a @Cond@} -%* * -%************************************************************************ +-- ----------------------------------------------------------------------------- +-- pprCond: print a 'Cond' -\begin{code} pprCond :: Cond -> Doc pprCond c = ptext (case c of { @@ -338,15 +369,11 @@ pprCond c = ptext (case c of { GU -> SLIT("gt"); LEU -> SLIT("le"); #endif }) -\end{code} -%************************************************************************ -%* * -\subsection{@pprImm@: print an @Imm@} -%* * -%************************************************************************ -\begin{code} +-- ----------------------------------------------------------------------------- +-- pprImm: print an 'Imm' + pprImm :: Imm -> Doc pprImm (ImmInt i) = int i @@ -357,9 +384,8 @@ pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty) <> pprCLabel_asm l <> char '+' <> int i pprImm (ImmLit s) = s -pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty) - <> (if dll then text "_imp__" else empty) - <> s +pprImm (ImmFloat _) = panic "pprImm:ImmFloat" +pprImm (ImmDouble _) = panic "pprImm:ImmDouble" #if sparc_TARGET_ARCH pprImm (LO i) @@ -388,6 +414,10 @@ pprImm (HA i) = hcat [ pp_ha, pprImm i, rparen ] where pp_ha = text "ha16(" + +pprImm (ImmDyldNonLazyPtr lbl) + = ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$non_lazy_ptr") + #else pprImm (LO i) = pprImm i <> text "@l" @@ -399,16 +429,12 @@ pprImm (HA i) = pprImm i <> text "@ha" #endif #endif -\end{code} -%************************************************************************ -%* * -\subsection{@pprAddr@: print an @Addr@} -%* * -%************************************************************************ -\begin{code} -pprAddr :: MachRegsAddr -> Doc +-- ----------------------------------------------------------------------------- +-- @pprAddr: print an 'AddrMode' + +pprAddr :: AddrMode -> Doc #if alpha_TARGET_ARCH pprAddr (AddrReg r) = parens (pprReg r) @@ -434,12 +460,12 @@ pprAddr (AddrBaseIndex base index displacement) = let pp_disp = ppr_disp displacement pp_off p = pp_disp <> char '(' <> p <> char ')' - pp_reg r = pprReg L r + pp_reg r = pprReg I32 r in case (base,index) of (Nothing, Nothing) -> pp_disp (Just b, Nothing) -> pp_off (pp_reg b) - (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i) + (Nothing, Just (r,i)) -> pp_off (comma <> pp_reg r <> comma <> int i) (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r <> comma <> int i) where @@ -465,8 +491,6 @@ pprAddr (AddrRegImm r1 (ImmInt i)) pprAddr (AddrRegImm r1 (ImmInteger i)) | i == 0 = pprReg r1 | not (fits13Bits i) = largeOffsetError i -------------------- - | otherwise = hcat [ pprReg r1, pp_sign, integer i ] where pp_sign = if i > 0 then char '+' else empty @@ -474,52 +498,37 @@ pprAddr (AddrRegImm r1 (ImmInteger i)) pprAddr (AddrRegImm r1 imm) = hcat [ pprReg r1, char '+', pprImm imm ] #endif + +------------------- + #if powerpc_TARGET_ARCH pprAddr (AddrRegReg r1 r2) - = error "PprMach.pprAddr (AddrRegReg) unimplemented" + = pprReg r1 <+> ptext SLIT(", ") <+> pprReg 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 (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ] #endif -\end{code} -%************************************************************************ -%* * -\subsection{@pprInstr@: print an @Instr@} -%* * -%************************************************************************ - -\begin{code} -pprInstr :: Instr -> Doc - ---pprInstr (COMMENT s) = empty -- nuke 'em -pprInstr (COMMENT s) - = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s)) - ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s)) - ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s)) - ,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s)) - ,)))) - -pprInstr (DELTA d) - = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) -pprInstr (SEGMENT TextSegment) - = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-} - ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-} - ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-} - ,IF_ARCH_powerpc(ptext SLIT(".text\n.align 2") - ,)))) +-- ----------------------------------------------------------------------------- +-- pprData: print a 'CmmStatic' -pprInstr (SEGMENT DataSegment) +pprSectionHeader Text + = ptext + IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-} + ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-} + ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-} + ,IF_ARCH_powerpc(SLIT(".text\n.align 2") + ,)))) +pprSectionHeader Data = ptext IF_ARCH_alpha(SLIT("\t.data\n\t.align 3") ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -} ,IF_ARCH_i386(SLIT(".data\n\t.align 4") ,IF_ARCH_powerpc(SLIT(".data\n.align 2") ,)))) - -pprInstr (SEGMENT RoDataSegment) +pprSectionHeader ReadOnlyData = ptext IF_ARCH_alpha(SLIT("\t.data\n\t.align 3") ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -} @@ -527,30 +536,40 @@ pprInstr (SEGMENT RoDataSegment) ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"), SLIT(".section .rodata\n\t.align 2")) ,)))) - -pprInstr (LABEL clab) - = let - pp_lab = pprCLabel_asm clab - in - hcat [ - if not (externallyVisibleCLabel clab) then - empty - else - hcat [ptext - IF_ARCH_alpha(SLIT("\t.globl\t") +pprSectionHeader UninitialisedData + = ptext + IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3") + ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -} + ,IF_ARCH_i386(SLIT(".section .bss\n\t.align 4") + ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"), + SLIT(".section .bss\n\t.align 2")) + ,)))) +pprSectionHeader (OtherSection sec) + = panic "PprMach.pprSectionHeader: unknown section" + +pprData :: CmmStatic -> Doc +pprData (CmmAlign bytes) = pprAlign bytes +pprData (CmmDataLabel lbl) = pprLabel lbl +pprData (CmmString str) = pprASCII str +pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes +pprData (CmmStaticLit lit) = pprDataItem lit + +pprGloblDecl :: CLabel -> Doc +pprGloblDecl lbl + | not (externallyVisibleCLabel lbl) = empty + | otherwise = ptext IF_ARCH_alpha(SLIT(".globl ") ,IF_ARCH_i386(SLIT(".globl ") - ,IF_ARCH_sparc(SLIT(".global\t") + ,IF_ARCH_sparc(SLIT(".global ") ,IF_ARCH_powerpc(SLIT(".globl ") - ,)))) - , pp_lab, char '\n'], - pp_lab, - char ':' - ] + ,)))) <> + pprCLabel_asm lbl -pprInstr (ASCII False{-no backslash conversion-} str) - = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ] +pprLabel :: CLabel -> Doc +pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':') -pprInstr (ASCII True str) + +-- Assume we want to backslash-convert the string +pprASCII str = vcat (map do1 (str ++ [chr 0])) where do1 :: Char -> Doc @@ -561,59 +580,84 @@ pprInstr (ASCII True str) = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16)) tab = "0123456789ABCDEF" +pprAlign bytes = + IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2, + IF_ARCH_i386(ptext SLIT(".align ") <> int bytes, + IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes, + IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))) + where + pow2 = log2 bytes + + log2 :: Int -> Int -- cache the common ones + log2 1 = 0 + log2 2 = 1 + log2 4 = 2 + log2 8 = 3 + log2 n = 1 + log2 (n `quot` 2) -pprInstr (DATA s xs) - = vcat (concatMap (ppr_item s) xs) + +pprDataItem :: CmmLit -> Doc +pprDataItem lit + = vcat (ppr_item (cmmLitRep lit) lit) where + imm = litToImm lit -#if alpha_TARGET_ARCH - ppr_item = error "ppr_item on Alpha" -#endif -#if sparc_TARGET_ARCH - -- copy n paste of x86 version - ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x] - ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x] - ppr_item F (ImmFloat r) + -- These seem to be common: + ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm] + ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm] + ppr_item F32 (CmmFloat r _) = let bs = floatToBytes (fromRational r) in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs - ppr_item DF (ImmDouble r) + ppr_item F64 (CmmFloat r _) = let bs = doubleToBytes (fromRational r) in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs + +#if sparc_TARGET_ARCH + -- copy n paste of x86 version + ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm] + ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm] #endif #if i386_TARGET_ARCH - ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x] - ppr_item L x = [ptext SLIT("\t.long\t") <> pprImm x] - ppr_item F (ImmFloat r) - = let bs = floatToBytes (fromRational r) - in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs - ppr_item DF (ImmDouble r) - = let bs = doubleToBytes (fromRational r) - in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs + ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm] + ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm] #endif #if powerpc_TARGET_ARCH - ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x] - ppr_item Bu x = [ptext SLIT("\t.byte\t") <> pprImm x] - ppr_item H x = [ptext SLIT("\t.short\t") <> pprImm x] - ppr_item Hu x = [ptext SLIT("\t.short\t") <> pprImm x] - ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x] - ppr_item F (ImmFloat r) - = let bs = floatToBytes (fromRational r) - in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs - ppr_item DF (ImmDouble r) - = let bs = doubleToBytes (fromRational r) - in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs + ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm] + ppr_item I64 (CmmInt x _) = + [ptext SLIT("\t.long\t") + <> int (fromIntegral + (fromIntegral (x `shiftR` 32) :: Word32)), + ptext SLIT("\t.long\t") + <> int (fromIntegral (fromIntegral x :: Word32))] #endif -- fall through to rest of (machine-specific) pprInstr... -\end{code} -%************************************************************************ -%* * -\subsubsection{@pprInstr@ for an Alpha} -%* * -%************************************************************************ +-- ----------------------------------------------------------------------------- +-- pprInstr: print an 'Instr' + +pprInstr :: Instr -> Doc + +--pprInstr (COMMENT s) = empty -- nuke 'em +pprInstr (COMMENT s) + = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s)) + ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s)) + ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s)) + ,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s)) + ,)))) + +pprInstr (DELTA d) + = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) + +pprInstr (NEWBLOCK _) + = panic "PprMach.pprInstr: NEWBLOCK" + +pprInstr (LDATA _ _) + = panic "PprMach.pprInstr: LDATA" + +-- ----------------------------------------------------------------------------- +-- pprInstr for an Alpha -\begin{code} #if alpha_TARGET_ARCH pprInstr (LD size reg addr) @@ -991,15 +1035,11 @@ pprSizeRegRegReg name size reg1 reg2 reg3 ] #endif /* alpha_TARGET_ARCH */ -\end{code} -%************************************************************************ -%* * -\subsubsection{@pprInstr@ for an I386} -%* * -%************************************************************************ -\begin{code} +-- ----------------------------------------------------------------------------- +-- pprInstr for an x86 + #if i386_TARGET_ARCH pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack @@ -1012,8 +1052,8 @@ pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack #endif pprInstr (MOV size src dst) = pprSizeOpOp SLIT("mov") size src dst -pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst -pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst +pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst +pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes I32 src dst -- here we do some patching, since the physical registers are only set late -- in the code generation. @@ -1034,6 +1074,8 @@ 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 @@ -1052,36 +1094,38 @@ pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst pprInstr (NOT size op) = pprSizeOp SLIT("not") size op pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op -pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst -pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst -pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst -pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src +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 (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src 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") + +-- both unused (SDM): +-- pprInstr PUSHA = ptext SLIT("\tpushal") +-- pprInstr POPA = ptext SLIT("\tpopal") pprInstr NOP = ptext SLIT("\tnop") pprInstr CLTD = ptext SLIT("\tcltd") -pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op) +pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op) -pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab) +pprInstr (JXX cond (BlockId id)) + = pprCondInstr SLIT("j") cond (pprCLabel_asm lab) + where lab = mkAsmTempLabel id -pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) -pprInstr (JMP dsts op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op) +pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) +pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand I32 op) +pprInstr (JMP_TBL op ids) = pprInstr (JMP op) pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm) -pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg L reg) - --- First bool indicates signedness; second whether quot or rem -pprInstr (IQUOT sz src dst) = pprInstr_quotRem True True sz src dst -pprInstr (IREM sz src dst) = pprInstr_quotRem True False sz src dst +pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg I32 reg) -pprInstr (QUOT sz src dst) = pprInstr_quotRem False True sz src dst -pprInstr (REM sz src dst) = pprInstr_quotRem False False sz src dst +pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op +pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo @@ -1115,12 +1159,12 @@ pprInstr g@(GFTOI src dst) pprInstr g@(GDTOI src dst) = pprG g (hcat [gtab, text "subl $4, %esp ; ", gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ", - pprReg L dst]) + pprReg I32 dst]) pprInstr g@(GITOF src dst) = pprInstr (GITOD src dst) pprInstr g@(GITOD src dst) - = pprG g (hcat [gtab, text "pushl ", pprReg L src, + = pprG g (hcat [gtab, text "pushl ", pprReg I32 src, text " ; ffree %st(7); fildl (%esp) ; ", gpop dst 1, text " ; addl $4,%esp"]) @@ -1283,33 +1327,11 @@ pprInstr GFREE ] -pprInstr_quotRem signed isQuot sz src dst - | case sz of L -> False; _ -> True - = panic "pprInstr_quotRem: dunno how to do non-32bit operands" - | otherwise - = vcat [ - (text "\t# BEGIN " <> fakeInsn), - (text "\tpushl $0; pushl %eax; pushl %edx; pushl " <> pprOperand sz src), - (text "\tmovl " <> pprOperand sz dst <> text ",%eax; " <> widen_to_64), - (x86op <> text " 0(%esp); movl " <> text resReg <> text ",12(%esp)"), - (text "\tpopl %edx; popl %edx; popl %eax; popl " <> pprOperand sz dst), - (text "\t# END " <> fakeInsn) - ] - where - widen_to_64 | signed = text "cltd" - | not signed = text "xorl %edx,%edx" - x86op = if signed then text "\tidivl" else text "\tdivl" - resReg = if isQuot then "%eax" else "%edx" - opStr | signed = if isQuot then "IQUOT" else "IREM" - | not signed = if isQuot then "QUOT" else "REM" - fakeInsn = text opStr <+> pprOperand sz src - <> char ',' <+> pprOperand sz dst - -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg pprInstr_imul64 hi_reg lo_reg = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg - pp_hi_reg = pprReg L hi_reg - pp_lo_reg = pprReg L lo_reg + pp_hi_reg = pprReg I32 hi_reg + pp_lo_reg = pprReg I32 lo_reg in vcat [ text "\t# BEGIN " <> fakeInsn, @@ -1326,15 +1348,14 @@ pprInstr_imul64 hi_reg lo_reg -------------------------- -- coerce %st(0) to the specified size -gcoerceto DF = empty -gcoerceto F = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; " +gcoerceto F64 = empty +gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; " 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' @@ -1348,20 +1369,20 @@ pprG :: Instr -> Doc -> Doc pprG fake actual = (char '#' <> pprGInstr fake) $$ actual -pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst +pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 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 (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst -pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst +pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst +pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst -pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst -pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst +pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst +pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 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 (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst +pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst -pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") DF co src dst +pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 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 @@ -1373,101 +1394,65 @@ pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 d 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} +-- Continue with I386-only printing bits and bobs: + pprDollImm :: Imm -> Doc pprDollImm i = ptext SLIT("$") <> pprImm i -pprOperand :: Size -> Operand -> Doc +pprOperand :: MachRep -> Operand -> Doc pprOperand s (OpReg r) = pprReg s r pprOperand s (OpImm i) = pprDollImm i pprOperand s (OpAddr ea) = pprAddr ea -pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc +pprMnemonic :: LitString -> MachRep -> Doc +pprMnemonic name size = + char '\t' <> ptext name <> pprSize size <> space + +pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc pprSizeImmOp name size imm op1 = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, char '$', pprImm imm, comma, pprOperand size op1 ] -pprSizeOp :: LitString -> Size -> Operand -> Doc +pprSizeOp :: LitString -> MachRep -> Operand -> Doc pprSizeOp name size op1 = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, pprOperand size op1 ] -pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc +pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc pprSizeOpOp name size op1 op2 = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, pprOperand size op1, comma, pprOperand size op2 ] -pprSizeByteOpOp :: LitString -> Size -> Operand -> Operand -> Doc -pprSizeByteOpOp name size op1 op2 - = hcat [ - char '\t', - ptext name, - pprSize size, - space, - pprOperand B op1, - comma, - pprOperand size op2 - ] - -pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc -pprSizeOpReg name size op1 reg - = hcat [ - char '\t', - ptext name, - pprSize size, - space, - pprOperand size op1, - comma, - pprReg size reg - ] - -pprSizeReg :: LitString -> Size -> Reg -> Doc +pprSizeReg :: LitString -> MachRep -> Reg -> Doc pprSizeReg name size reg1 = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, pprReg size reg1 ] -pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc +pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc pprSizeRegReg name size reg1 reg2 = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, pprReg size reg1, comma, pprReg size reg2 ] -pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc +pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc pprCondRegReg name size cond reg1 reg2 = hcat [ char '\t', @@ -1479,7 +1464,7 @@ pprCondRegReg name size cond reg1 reg2 pprReg size reg2 ] -pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc +pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc pprSizeSizeRegReg name size1 size2 reg1 reg2 = hcat [ char '\t', @@ -1493,13 +1478,10 @@ pprSizeSizeRegReg name size1 size2 reg1 reg2 pprReg size2 reg2 ] -pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc +pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc pprSizeRegRegReg name size reg1 reg2 reg3 = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, pprReg size reg1, comma, pprReg size reg2, @@ -1507,51 +1489,34 @@ pprSizeRegRegReg name size reg1 reg2 reg3 pprReg size reg3 ] -pprSizeAddr :: LitString -> Size -> MachRegsAddr -> Doc -pprSizeAddr name size op - = hcat [ - char '\t', - ptext name, - pprSize size, - space, - pprAddr op - ] - -pprSizeAddrReg :: LitString -> Size -> MachRegsAddr -> Reg -> Doc +pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc pprSizeAddrReg name size op dst = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, pprAddr op, comma, pprReg size dst ] -pprSizeRegAddr :: LitString -> Size -> Reg -> MachRegsAddr -> Doc +pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc pprSizeRegAddr name size src op = hcat [ - char '\t', - ptext name, - pprSize size, - space, + pprMnemonic name size, pprReg size src, comma, pprAddr op ] -pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc -pprOpOp name size op1 op2 +pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc +pprShift name size src dest = hcat [ - char '\t', - ptext name, space, - pprOperand size op1, + pprMnemonic name size, + pprOperand I8 src, -- src is 8-bit sized comma, - pprOperand size op2 + pprOperand size dest ] -pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc +pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc pprSizeOpOpCoerce name size1 size2 op1 op2 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space, pprOperand size1 op1, @@ -1564,15 +1529,10 @@ pprCondInstr name cond arg = hcat [ char '\t', ptext name, pprCond cond, space, arg] #endif /* i386_TARGET_ARCH */ -\end{code} -%************************************************************************ -%* * -\subsubsection{@pprInstr@ for a SPARC} -%* * -%************************************************************************ -\begin{code} +-- ------------------------------------------------------------------------------- pprInstr for a SPARC + #if sparc_TARGET_ARCH -- a clumsy hack for now, to handle possible double alignment problems @@ -1851,27 +1811,39 @@ pp_comma_lbracket = text ",[" pp_comma_a = text ",a" #endif /* sparc_TARGET_ARCH */ -\end{code} -%************************************************************************ -%* * -\subsubsection{@pprInstr@ for PowerPC} -%* * -%************************************************************************ -\begin{code} +-- ----------------------------------------------------------------------------- +-- pprInstr for PowerPC + #if powerpc_TARGET_ARCH pprInstr (LD sz reg addr) = hcat [ char '\t', ptext SLIT("l"), ptext (case sz of - B -> SLIT("ba") - Bu -> SLIT("bz") - H -> SLIT("ha") - Hu -> SLIT("hz") - W -> SLIT("wz") - F -> SLIT("fs") - DF -> SLIT("fd")), + I8 -> SLIT("bz") + I16 -> SLIT("hz") + I32 -> SLIT("wz") + F32 -> SLIT("fs") + F64 -> SLIT("fd")), + case addr of AddrRegImm _ _ -> empty + AddrRegReg _ _ -> char 'x', + char '\t', + pprReg reg, + ptext SLIT(", "), + pprAddr addr + ] +pprInstr (LA sz reg addr) = hcat [ + char '\t', + ptext SLIT("l"), + ptext (case sz of + I8 -> SLIT("ba") + I16 -> SLIT("ha") + I32 -> SLIT("wa") + F32 -> SLIT("fs") + F64 -> SLIT("fd")), + case addr of AddrRegImm _ _ -> empty + AddrRegReg _ _ -> char 'x', char '\t', pprReg reg, ptext SLIT(", "), @@ -1881,6 +1853,8 @@ pprInstr (ST sz reg addr) = hcat [ char '\t', ptext SLIT("st"), pprSize sz, + case addr of AddrRegImm _ _ -> empty + AddrRegReg _ _ -> char 'x', char '\t', pprReg reg, ptext SLIT(", "), @@ -1891,6 +1865,8 @@ pprInstr (STU sz reg addr) = hcat [ ptext SLIT("st"), pprSize sz, ptext SLIT("u\t"), + case addr of AddrRegImm _ _ -> empty + AddrRegReg _ _ -> char 'x', pprReg reg, ptext SLIT(", "), pprAddr addr @@ -1955,13 +1931,21 @@ pprInstr (CMPL sz reg ri) = hcat [ RIReg _ -> empty RIImm _ -> char 'i' ] -pprInstr (BCC cond lbl) = hcat [ +pprInstr (BCC cond (BlockId id)) = hcat [ char '\t', ptext SLIT("b"), pprCond cond, char '\t', pprCLabel_asm lbl ] + where lbl = mkAsmTempLabel id + +pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel + char '\t', + ptext SLIT("b"), + char '\t', + pprCLabel_asm lbl + ] pprInstr (MTCTR reg) = hcat [ char '\t', @@ -1973,23 +1957,45 @@ pprInstr (BCTR _) = hcat [ char '\t', ptext SLIT("bctr") ] -pprInstr (BL imm _) = hcat [ - char '\t', - ptext SLIT("bl"), - char '\t', - pprImm imm +pprInstr (BL lbl _) = hcat [ + ptext SLIT("\tbl\tL"), + pprCLabel_asm lbl, + ptext SLIT("$stub") ] pprInstr (BCTRL _) = hcat [ char '\t', ptext SLIT("bctrl") ] pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri +pprInstr (ADDIS reg1 reg2 imm) = hcat [ + char '\t', + ptext SLIT("addis"), + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2, + ptext SLIT(", "), + pprImm imm + ] + +pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3) +pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3) pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3) pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3) pprInstr (DIVWU reg1 reg2 reg3) = pprLogic 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(", "), + ptext SLIT("2, 31, 31") ] + ] + -- for some reason, "andi" doesn't exist. -- we'll use "andi." instead. pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [ @@ -2002,10 +2008,10 @@ pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [ ptext SLIT(", "), pprImm imm ] -pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 (toUI16 ri) +pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri -pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 (toUI16 ri) -pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 (toUI16 ri) +pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri +pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri pprInstr (XORIS reg1 reg2 imm) = hcat [ char '\t', @@ -2018,12 +2024,35 @@ pprInstr (XORIS reg1 reg2 imm) = hcat [ pprImm imm ] -pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 ri -pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 ri -pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 ri +pprInstr (EXTS sz reg1 reg2) = hcat [ + char '\t', + ptext SLIT("exts"), + pprSize sz, + char '\t', + pprReg reg1, + ptext SLIT(", "), + pprReg reg2 + ] + pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2 +pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri) +pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri) +pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri) +pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [ + ptext SLIT("\trlwinm\t"), + pprReg reg1, + ptext SLIT(", "), + pprReg reg2, + ptext SLIT(", "), + int sh, + ptext SLIT(", "), + int mb, + ptext SLIT(", "), + 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 @@ -2042,8 +2071,25 @@ pprInstr (FCMP reg1 reg2) = hcat [ ] pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2 +pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2 + +pprInstr (CRNOR dst src1 src2) = hcat [ + ptext SLIT("\tcrnor\t"), + int dst, + ptext SLIT(", "), + int src1, + ptext SLIT(", "), + int src2 + ] -pprInstr _ = ptext SLIT("something") +pprInstr (MFCR reg) = hcat [ + char '\t', + ptext SLIT("mfcr"), + char '\t', + pprReg reg + ] + +pprInstr _ = panic "pprInstr (ppc)" pprLogic op reg1 reg2 ri = hcat [ char '\t', @@ -2084,18 +2130,14 @@ pprRI :: RI -> Doc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprFSize DF = empty -pprFSize F = char 's' +pprFSize F64 = empty +pprFSize F32 = char 's' --- hack to ensure that negative vals come out in non-negative form --- (assuming that fromIntegral{Int->Word16} will do a 'c-style' --- conversion, and not throw a fit/exception.) -toUI16 :: RI -> RI -toUI16 (RIImm (ImmInt x)) - | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16))) -toUI16 (RIImm (ImmInteger x)) - | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16))) -toUI16 x = x + -- limit immediate argument for shift instruction to range 0..32 + -- (yes, the maximum is really 32, not 31) +limitShiftRI :: RI -> RI +limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32) +limitShiftRI x = x {- The Mach-O object file format used in Darwin/Mac OS X needs a so-called @@ -2107,28 +2149,39 @@ toUI16 x = x -} #if darwin_TARGET_OS -pprDyldSymbolStub fn = +pprDyldSymbolStub (True, lbl) = vcat [ ptext SLIT(".symbol_stub"), - ptext SLIT("L_") <> ftext fn <> ptext SLIT("$stub:"), - ptext SLIT("\t.indirect_symbol _") <> ftext fn, - ptext SLIT("\tlis r11,ha16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"), - ptext SLIT("\tlwz r12,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)(r11)"), + ptext SLIT("L") <> pprLbl <> ptext SLIT("$stub:"), + ptext SLIT("\t.indirect_symbol") <+> pprLbl, + ptext SLIT("\tlis r11,ha16(L") <> pprLbl <> ptext SLIT("$lazy_ptr)"), + ptext SLIT("\tlwz r12,lo16(L") <> pprLbl <> ptext SLIT("$lazy_ptr)(r11)"), ptext SLIT("\tmtctr r12"), - ptext SLIT("\taddi r11,r11,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"), + ptext SLIT("\taddi r11,r11,lo16(L") <> pprLbl <> ptext SLIT("$lazy_ptr)"), ptext SLIT("\tbctr"), ptext SLIT(".lazy_symbol_pointer"), - ptext SLIT("L_") <> ftext fn <> ptext SLIT("$lazy_ptr:"), - ptext SLIT("\t.indirect_symbol _") <> ftext fn, + ptext SLIT("L") <> pprLbl <> ptext SLIT("$lazy_ptr:"), + ptext SLIT("\t.indirect_symbol") <+> pprLbl, ptext SLIT("\t.long dyld_stub_binding_helper") ] + where pprLbl = pprCLabel_asm lbl + +pprDyldSymbolStub (False, lbl) = + vcat [ + ptext SLIT(".non_lazy_symbol_pointer"), + char 'L' <> pprLbl <> ptext SLIT("$non_lazy_ptr:"), + ptext SLIT("\t.indirect_symbol") <+> pprLbl, + ptext SLIT("\t.long\t0") + ] + where pprLbl = pprCLabel_asm lbl #endif - #endif /* powerpc_TARGET_ARCH */ -\end{code} -\begin{code} + +-- ----------------------------------------------------------------------------- +-- Converting floating-point literals to integrals for printing + #if __GLASGOW_HASKELL__ >= 504 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float) newFloatArray = newArray_ @@ -2202,4 +2255,3 @@ doubleToBytes d i7 <- readCharArray arr 7 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7]) ) -\end{code}