projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2003-12-10 11:35:24 by wolfgang]
[ghc-hetmet.git] / ghc / compiler / nativeGen / PprMach.lhs
diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 1265384..0a6b136 100644 (file)
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -10,7 +10,7 @@ We start with the @pprXXX@s with some cross-platform commonality
 \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"
 
@@ -19,7 +19,6 @@ import MachMisc
 
 import CLabel          ( pprCLabel, externallyVisibleCLabel, labelDynamic )
 import Stix            ( CodeSegment(..) )
-import Unique          ( pprUnique )
 import Panic           ( panic )
 import Pretty
 import FastString
@@ -27,9 +26,10 @@ import qualified Outputable
 
 #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
@@ -177,6 +177,7 @@ pprReg IF_ARCH_i386(s,) r
       })
 #endif
 #if powerpc_TARGET_ARCH
+#if darwin_TARGET_OS
     ppr_reg_no :: Int -> Doc
     ppr_reg_no i = ptext
       (case i of {
@@ -214,6 +215,12 @@ pprReg IF_ARCH_i386(s,) r
        62 -> SLIT("f30"); 63 -> SLIT("f31");
        _  -> SLIT("very naughty powerpc register")
       })
+#else
+    ppr_reg_no :: Int -> Doc
+    ppr_reg_no i | i <= 31 = int i     -- GPRs
+                 | i <= 63 = int (i-32) -- FPRs
+                | otherwise = ptext SLIT("very naughty powerpc register")
+#endif
 #endif
 \end{code}
 
@@ -366,6 +373,7 @@ pprImm (HI i)
     pp_hi = text "%hi("
 #endif
 #if powerpc_TARGET_ARCH
+#if darwin_TARGET_OS
 pprImm (LO i)
   = hcat [ pp_lo, pprImm i, rparen ]
   where
@@ -380,6 +388,16 @@ pprImm (HA i)
   = hcat [ pp_ha, pprImm i, rparen ]
   where
     pp_ha = text "ha16("
+#else
+pprImm (LO i)
+  = pprImm i <> text "@l"
+
+pprImm (HI i)
+  = pprImm i <> text "@h"
+
+pprImm (HA i)
+  = pprImm i <> text "@ha"
+#endif
 #endif
 \end{code}
 
@@ -506,7 +524,8 @@ pprInstr (SEGMENT RoDataSegment)
         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(".section .rodata\n\t.align 4")
-        ,IF_ARCH_powerpc(SLIT(".const_data\n.align 2")
+        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
+                                      SLIT(".section .rodata\n\t.align 2"))
        ,))))
 
 pprInstr (LABEL clab)
@@ -574,8 +593,8 @@ pprInstr (DATA s xs)
 #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.byte\t") <> pprImm x]
-       ppr_item Hu  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)
@@ -971,7 +990,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3
        pprReg reg3
     ]
 
-#endif {-alpha_TARGET_ARCH-}
+#endif /* alpha_TARGET_ARCH */
 \end{code}
 
 %************************************************************************
@@ -1544,7 +1563,7 @@ pprCondInstr :: LitString -> Cond -> Doc -> Doc
 pprCondInstr name cond arg
   = hcat [ char '\t', ptext name, pprCond cond, space, arg]
 
-#endif {-i386_TARGET_ARCH-}
+#endif /* i386_TARGET_ARCH */
 \end{code}
 
 %************************************************************************
@@ -1831,7 +1850,7 @@ pp_rbracket_comma = text "],"
 pp_comma_lbracket = text ",["
 pp_comma_a       = text ",a"
 
-#endif {-sparc_TARGET_ARCH-}
+#endif /* sparc_TARGET_ARCH */
 \end{code}
 
 %************************************************************************
@@ -1892,7 +1911,9 @@ pprInstr (LI reg imm) = hcat [
        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")
@@ -1948,7 +1969,7 @@ pprInstr (MTCTR reg) = hcat [
        char '\t',
        pprReg reg
     ]
-pprInstr (BCTR) = hcat [
+pprInstr (BCTR _) = hcat [
        char '\t',
        ptext SLIT("bctr")
     ]
@@ -1963,14 +1984,40 @@ pprInstr (BCTRL _) = hcat [
        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
@@ -1981,6 +2028,7 @@ pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
+pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
 
 pprInstr (FCMP reg1 reg2) = hcat [
        char '\t',
@@ -1993,6 +2041,8 @@ pprInstr (FCMP reg1 reg2) = hcat [
        pprReg reg2
     ]
 
+pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
+
 pprInstr _ = ptext SLIT("something")
 
 pprLogic op reg1 reg2 ri = hcat [
@@ -2037,7 +2087,45 @@ pprRI (RIImm r) = pprImm r
 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}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)