projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2005-04-27 09:57:14 by simonmar]
[ghc-hetmet.git] / ghc / compiler / nativeGen / PprMach.hs
diff --git a/ghc/compiler/nativeGen/PprMach.hs b/ghc/compiler/nativeGen/PprMach.hs
index 1f1adda..61faf24 100644 (file)
--- a/ghc/compiler/nativeGen/PprMach.hs
+++ b/ghc/compiler/nativeGen/PprMach.hs
@@ -117,11 +117,11 @@ pprBasicBlock (BasicBlock (BlockId id) instrs) =
 pprUserReg :: Reg -> Doc
 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
 
-pprReg :: IF_ARCH_i386(MachRep ->, IF_ARCH_x86_64(MachRep ->,)) Reg -> Doc
+pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
 
-pprReg IF_ARCH_i386(s, IF_ARCH_x86_64(s,)) r
+pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
   = case r of
-      RealReg i      -> ppr_reg_no IF_ARCH_i386(s, IF_ARCH_x86_64(s,)) i
+      RealReg i      -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
       VirtualRegI  u  -> text "%vI_" <> asmSDoc (pprUnique u)
       VirtualRegHi u  -> text "%vHi_" <> asmSDoc (pprUnique u)
       VirtualRegF  u  -> text "%vF_" <> asmSDoc (pprUnique u)
@@ -263,8 +263,9 @@ pprReg IF_ARCH_i386(s, IF_ARCH_x86_64(s,)) r
        22 -> SLIT("%xmm6");   23 -> SLIT("%xmm7");
        24 -> SLIT("%xmm8");   25 -> SLIT("%xmm9");
        26 -> SLIT("%xmm10");  27 -> SLIT("%xmm11");
-       28 -> SLIT("%xmm12");  28 -> SLIT("%xmm13");
-       30 -> SLIT("%xmm13");  31 -> SLIT("%xmm15")
+       28 -> SLIT("%xmm12");  29 -> SLIT("%xmm13");
+       30 -> SLIT("%xmm14");  31 -> SLIT("%xmm15");
+       _  -> SLIT("very naughty x86_64 register")
       })
 #endif
 
@@ -385,8 +386,8 @@ pprSize x = ptext (case x of
        I64  -> SLIT("q")
 #endif
 #if i386_TARGET_ARCH
-       F32  -> SLIT("l")
-       F64  -> SLIT("q")
+       F32  -> SLIT("s")
+       F64  -> SLIT("l")
        F80  -> SLIT("t")
 #endif
 #if x86_64_TARGET_ARCH
@@ -445,6 +446,7 @@ pprCond c = ptext (case c of {
        LEU     -> SLIT("be");  NE    -> SLIT("ne");
        NEG     -> SLIT("s");   POS   -> SLIT("ns");
         CARRY   -> SLIT("c");   OFLO  -> SLIT("o");
+       PARITY  -> SLIT("p");   NOTPARITY -> SLIT("np");
        ALWAYS  -> SLIT("mp")   -- hack
 #endif
 #if sparc_TARGET_ARCH
@@ -479,8 +481,8 @@ pprImm (ImmCLbl l)    = pprCLabel_asm l
 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
 pprImm (ImmLit s)     = s
 
-pprImm (ImmFloat _) = panic "pprImm:ImmFloat"
-pprImm (ImmDouble _) = panic "pprImm:ImmDouble"
+pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
+pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
 
 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
@@ -559,10 +561,11 @@ pprAddr (AddrBaseIndex base index displacement)
        pp_reg r = pprReg wordRep r
     in
     case (base,index) of
-      (Nothing, Nothing)    -> pp_disp
-      (Just b,  Nothing)    -> pp_off (pp_reg b)
-      (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 
+      (EABaseNone,  EAIndexNone) -> pp_disp
+      (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
+      (EABaseRip,   EAIndexNone) -> pp_off (ptext SLIT("%rip"))
+      (EABaseNone,  EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
+      (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r 
                                        <> comma <> int i)
   where
     ppr_disp (ImmInt 0) = empty
@@ -640,15 +643,10 @@ pprSectionHeader RelocatableReadOnlyData
         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_x86_64(SLIT(".text\n\t.align 8")
+       ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
         ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
                                       SLIT(".data\n\t.align 2"))
        ,)))))
-       -- the assembler on x86_64/Linux refuses to generate code for
-       --   .quad  x - y
-       -- where x is in the text section and y in the rodata section.
-       -- It works if y is in the text section, though.  This is probably
-       -- going to cause difficulties for PIC, I imagine.
 pprSectionHeader UninitialisedData
     = ptext
         IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
@@ -741,8 +739,29 @@ pprDataItem lit
 #endif
 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
        ppr_item I16  x = [ptext SLIT("\t.word\t") <> pprImm imm]
+#endif
+#if i386_TARGET_ARCH
        ppr_item I64  x = [ptext SLIT("\t.quad\t") <> pprImm imm]
 #endif
+#if x86_64_TARGET_ARCH
+       -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
+       -- type, which means we can't do pc-relative 64-bit addresses.
+       -- Fortunately we're assuming the small memory model, in which
+       -- all such offsets will fit into 32 bits, so we have to stick
+       -- to 32-bit offset fields and modify the RTS appropriately
+       -- (see InfoTables.h).
+       -- 
+       ppr_item I64  x 
+          | isRelativeReloc x =
+               [ptext SLIT("\t.long\t") <> pprImm imm,
+                ptext SLIT("\t.long\t0")]
+          | otherwise =
+               [ptext SLIT("\t.quad\t") <> pprImm imm]
+          where
+               isRelativeReloc (CmmLabelOff _ _)       = True
+               isRelativeReloc (CmmLabelDiffOff _ _ _) = True
+               isRelativeReloc _ = False
+#endif
 #if powerpc_TARGET_ARCH
        ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
         ppr_item I64 (CmmInt x _)  =
@@ -1185,18 +1204,22 @@ pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
        -- the reg alloc would tend to throw away a plain reg-to-reg
        -- move, and we still want it to do that.
 
-pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes wordRep src dst
+pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 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 (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
 
 -- here we do some patching, since the physical registers are only set late
 -- in the code generation.
-pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
+pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
   | reg1 == reg3
   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
-pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
+pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
   | reg2 == reg3
   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
-pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
+pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
   | reg1 == reg3
   = pprInstr (ADD size (OpImm displ) dst)
 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
@@ -1260,8 +1283,8 @@ pprInstr (JXX cond (BlockId id))
 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
 pprInstr (JMP op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep 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 wordRep reg)
+pprInstr (CALL (Left imm) _)    = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
+pprInstr (CALL (Right reg) _)   = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
 
 pprInstr (IDIV sz op)  = pprSizeOp SLIT("idiv") sz op
 pprInstr (DIV sz op)    = pprSizeOp SLIT("div")  sz op
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)