\begin{code}
#include "nativeGen/NCG.h"
-module PprMach ( pprInstr, pprSize, pprUserReg ) where
+module PprMach ( pprInstr, pprSize, pprUserReg IF_OS_darwin(COMMA pprDyldSymbolStub, ) ) where
#include "HsVersions.h"
import CLabel ( pprCLabel, externallyVisibleCLabel, labelDynamic )
import Stix ( CodeSegment(..) )
-import Unique ( pprUnique )
import Panic ( panic )
import Pretty
import FastString
#if __GLASGOW_HASKELL__ >= 504
import Data.Array.ST
-import Data.Word ( Word8 )
+import Data.Word ( Word8, Word16 )
#else
import MutableArray
+import Word ( Word16 )
#endif
import MONAD_ST
pprReg reg3
]
-#endif {-alpha_TARGET_ARCH-}
+#endif /* alpha_TARGET_ARCH */
\end{code}
%************************************************************************
pprCondInstr name cond arg
= hcat [ char '\t', ptext name, pprCond cond, space, arg]
-#endif {-i386_TARGET_ARCH-}
+#endif /* i386_TARGET_ARCH */
\end{code}
%************************************************************************
pp_comma_lbracket = text ",["
pp_comma_a = text ",a"
-#endif {-sparc_TARGET_ARCH-}
+#endif /* sparc_TARGET_ARCH */
\end{code}
%************************************************************************
ptext SLIT(", "),
pprImm imm
]
-pprInstr (MR reg1 reg2) = hcat [
+pprInstr (MR reg1 reg2)
+ | reg1 == reg2 = empty
+ | otherwise = hcat [
char '\t',
case regClass reg1 of
RcInteger -> ptext SLIT("mr")
char '\t',
pprReg reg
]
-pprInstr (BCTR) = hcat [
+pprInstr (BCTR _) = hcat [
char '\t',
ptext SLIT("bctr")
]
ptext SLIT("bctrl")
]
pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
-pprInstr (SUBF reg1 reg2 ri) = pprLogic SLIT("subf") reg1 reg2 ri
+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 (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
-pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
-pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
+
+ -- for some reason, "andi" doesn't exist.
+ -- we'll use "andi." instead.
+pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
+ char '\t',
+ ptext SLIT("andi."),
+ char '\t',
+ pprReg reg1,
+ ptext SLIT(", "),
+ pprReg reg2,
+ ptext SLIT(", "),
+ pprImm imm
+ ]
+pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 (toUI16 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 (XORIS reg1 reg2 imm) = hcat [
+ char '\t',
+ ptext SLIT("xoris"),
+ char '\t',
+ pprReg reg1,
+ ptext SLIT(", "),
+ pprReg reg2,
+ ptext SLIT(", "),
+ 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 (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
+pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
pprInstr (FCMP reg1 reg2) = hcat [
char '\t',
pprReg reg2
]
+pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
+
pprInstr _ = ptext SLIT("something")
pprLogic op reg1 reg2 ri = hcat [
pprFSize DF = empty
pprFSize F = char 's'
-#endif {-powerpc_TARGET_ARCH-}
+-- 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
+
+{-
+ The Mach-O object file format used in Darwin/Mac OS X needs a so-called
+ "symbol stub" for every function that might be imported from a dynamic
+ library.
+ The stubs are always the same, and they are all output at the end of the
+ generated assembly (see AsmCodeGen.lhs), so we don't use the Instr datatype.
+ Instead, we just pretty-print it directly.
+-}
+
+#if darwin_TARGET_OS
+pprDyldSymbolStub fn =
+ 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("\tmtctr r12"),
+ ptext SLIT("\taddi r11,r11,lo16(L_") <> ftext fn <> 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("\t.long dyld_stub_binding_helper")
+ ]
+#endif
+
+
+#endif /* powerpc_TARGET_ARCH */
\end{code}
\begin{code}