-%
-% (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
})
#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 {
| 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
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")
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 {
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
<> 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)
= 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"
= 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)
= 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
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
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 -}
,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
= 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)
]
#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
#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.
= 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
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
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"])
]
-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,
--------------------------
-- 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'
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
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',
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',
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,
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,
= 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
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(", "),
char '\t',
ptext SLIT("st"),
pprSize sz,
+ case addr of AddrRegImm _ _ -> empty
+ AddrRegReg _ _ -> char 'x',
char '\t',
pprReg reg,
ptext SLIT(", "),
ptext SLIT("st"),
pprSize sz,
ptext SLIT("u\t"),
+ case addr of AddrRegImm _ _ -> empty
+ AddrRegReg _ _ -> char 'x',
pprReg reg,
ptext SLIT(", "),
pprAddr addr
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',
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 [
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',
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
]
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',
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
-}
#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_
i7 <- readCharArray arr 7
return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
)
-\end{code}
projects / ghc-hetmet.git / blobdiff