X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=ea296ef27a632a18aa6c2deeddc4fff6b1177257;hb=4070b105490709e2fbc40ef926853fc93595b7a6;hp=6232f3751b1c98035d1edc264ad79e1fdd3397f4;hpb=c39373f1371fd1e46ea91be262f00c277b31f8e5;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 6232f37..ea296ef 100644
--- 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 ) where
+module PprMach ( pprInstr, pprSize, pprUserReg ) where
 
 #include "HsVersions.h"
 
@@ -38,6 +38,10 @@ import Char		( ord )
 For x86, the way we print a register name depends
 on which bit of it we care about.  Yurgh.
 \begin{code}
+pprUserReg:: Reg -> SDoc
+pprUserReg = pprReg IF_ARCH_i386(L,)
+
+
 pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
 
 pprReg IF_ARCH_i386(s,) r
@@ -94,49 +98,16 @@ pprReg IF_ARCH_i386(s,) r
 	_ -> SLIT("very naughty I386 byte register")
       })
 
-{- UNUSED:
-    ppr_reg_no HB i = ptext
-      (case i of {
-	ILIT( 0) -> SLIT("%ah");  ILIT( 1) -> SLIT("%bh");
-	ILIT( 2) -> SLIT("%ch");  ILIT( 3) -> SLIT("%dh");
-	_ -> SLIT("very naughty I386 high byte register")
-      })
--}
-
-{- UNUSED:
-    ppr_reg_no S i = ptext
-      (case i of {
-	ILIT( 0) -> SLIT("%ax");  ILIT( 1) -> SLIT("%bx");
-	ILIT( 2) -> SLIT("%cx");  ILIT( 3) -> SLIT("%dx");
-	ILIT( 4) -> SLIT("%si");  ILIT( 5) -> SLIT("%di");
-	ILIT( 6) -> SLIT("%bp");  ILIT( 7) -> SLIT("%sp");
-	_ -> SLIT("very naughty I386 word register")
-      })
--}
-
-    ppr_reg_no L i = ptext
+    ppr_reg_no _ i = ptext
       (case i of {
 	ILIT( 0) -> SLIT("%eax");  ILIT( 1) -> SLIT("%ebx");
 	ILIT( 2) -> SLIT("%ecx");  ILIT( 3) -> SLIT("%edx");
 	ILIT( 4) -> SLIT("%esi");  ILIT( 5) -> SLIT("%edi");
 	ILIT( 6) -> SLIT("%ebp");  ILIT( 7) -> SLIT("%esp");
-	_ -> SLIT("very naughty I386 double word register")
-      })
-
-    ppr_reg_no F i = ptext
-      (case i of {
 	ILIT( 8) -> SLIT("%fake0");  ILIT( 9) -> SLIT("%fake1");
 	ILIT(10) -> SLIT("%fake2");  ILIT(11) -> SLIT("%fake3");
 	ILIT(12) -> SLIT("%fake4");  ILIT(13) -> SLIT("%fake5");
-	_ -> SLIT("very naughty I386 float register")
-      })
-
-    ppr_reg_no DF i = ptext
-      (case i of {
-	ILIT( 8) -> SLIT("%fake0");  ILIT( 9) -> SLIT("%fake1");
-	ILIT(10) -> SLIT("%fake2");  ILIT(11) -> SLIT("%fake3");
-	ILIT(12) -> SLIT("%fake4");  ILIT(13) -> SLIT("%fake5");
-	_ -> SLIT("very naughty I386 float register")
+	_ -> SLIT("very naughty I386 register")
       })
 #endif
 #if sparc_TARGET_ARCH
@@ -204,12 +175,13 @@ pprSize x = ptext (case x of
 	 TF -> SLIT("t")
 #endif
 #if i386_TARGET_ARCH
-	B  -> SLIT("b")
---	HB -> SLIT("b") UNUSED
---	S  -> SLIT("w") UNUSED
-	L  -> SLIT("l")
-	F  -> SLIT("s")
-	DF -> SLIT("l")
+	B   -> SLIT("b")
+--	HB  -> SLIT("b") UNUSED
+--	S   -> SLIT("w") UNUSED
+	L   -> SLIT("l")
+	F   -> SLIT("s")
+	DF  -> SLIT("l")
+	F80 -> SLIT("t")
 #endif
 #if sparc_TARGET_ARCH
 	B   -> SLIT("sb")
@@ -328,27 +300,27 @@ pprAddr (AddrRegImm r1 i)
 
 #if i386_TARGET_ARCH
 pprAddr (ImmAddr imm off)
-  = let
-	pp_imm = pprImm imm
+  = let	pp_imm = pprImm imm
     in
     if (off == 0) then
 	pp_imm
     else if (off < 0) then
-	(<>) pp_imm (int off)
+	pp_imm <> int off
     else
-	hcat [pp_imm, char '+', int off]
+	pp_imm <> char '+' <> int off
 
 pprAddr (AddrBaseIndex base index displacement)
   = let
 	pp_disp  = ppr_disp displacement
-	pp_off p = (<>) pp_disp (parens p)
+	pp_off p = pp_disp <> char '(' <> p <> char ')'
 	pp_reg r = pprReg L r
     in
     case (base,index) of
       (Nothing, Nothing)    -> pp_disp
       (Just b,  Nothing)    -> pp_off (pp_reg b)
-      (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
-      (Just b,  Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
+      (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
+      (Just b,  Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r 
+                                       <> comma <> int i)
   where
     ppr_disp (ImmInt 0) = empty
     ppr_disp imm        = pprImm imm
@@ -397,6 +369,9 @@ pprInstr (COMMENT s)
      ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ptext s))
      ,)))
 
+pprInstr (DELTA d)
+   = pprInstr (COMMENT (_PK_ ("\tdelta = " ++ show d)))
+
 pprInstr (SEGMENT TextSegment)
     =  IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
       ,IF_ARCH_sparc(ptext SLIT("\t.text\n\t.align 4") {-word boundary-}
@@ -977,9 +952,10 @@ 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) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("shl")  size imm dst
-pprInstr (SAR size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("sar")  size imm dst
-pprInstr (SHR size imm dst) = {-pprSizeByteOpOp-} pprSizeOpOp SLIT("shr")  size imm dst
+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 (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
@@ -989,7 +965,6 @@ pprInstr PUSHA = ptext SLIT("\tpushal")
 pprInstr POPA = ptext SLIT("\tpopal")
 
 pprInstr (NOP) = ptext SLIT("\tnop")
-pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
 pprInstr (CLTD) = ptext SLIT("\tcltd")
 
 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
@@ -1021,6 +996,11 @@ pprInstr g@(GST sz src addr)
  = pprG g (hcat [gtab, gpush src 0, gsemi, 
                  text "fstp", pprSize sz, gsp, pprAddr addr])
 
+pprInstr g@(GLDZ dst)
+ = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
+pprInstr g@(GLD1 dst)
+ = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
+
 pprInstr g@(GFTOD src dst) 
    = pprG g bogus
 pprInstr g@(GFTOI src dst) 
@@ -1032,9 +1012,11 @@ pprInstr g@(GDTOI src dst)
    = pprG g bogus
 
 pprInstr g@(GITOF src dst) 
-   = pprG g bogus
+   = pprInstr (GITOD src dst)
 pprInstr g@(GITOD src dst) 
-   = pprG g bogus
+   = pprG g (hcat [gtab, text "pushl ", pprReg L src, 
+                   text " ; ffree %st(7); fildl (%esp) ; ",
+                   gpop dst 1, text " ; addl $4,%esp"])
 
 pprInstr g@(GCMP sz src1 src2) 
    = pprG g (hcat [gtab, text "pushl %eax ; ",
@@ -1046,17 +1028,21 @@ pprInstr g@(GABS sz src dst)
    = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
 pprInstr g@(GNEG sz src dst)
    = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
+
 pprInstr g@(GSQRT sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt ; ", gpop dst 1])
+   = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$ 
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 pprInstr g@(GSIN sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fsin ; ", gpop dst 1])
+   = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$ 
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 pprInstr g@(GCOS sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fcos ; ", gpop dst 1])
-
+   = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$ 
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 pprInstr g@(GTAN sz src dst)
    = pprG g (hcat [gtab, text "ffree %st(6) ; ",
                    gpush src 0, text " ; fptan ; ", 
-                   text " fstp %st(0) ; ", gpop dst 1])
+                   text " fstp %st(0)"] $$
+             hcat [gtab, gcoerceto sz, gpop dst 1])
 
 pprInstr g@(GADD sz src1 src2 dst)
    = pprG g (hcat [gtab, gpush src1 0, 
@@ -1081,6 +1067,11 @@ pprInstr GFREE
           ]
 
 --------------------------
+
+-- coerce %st(0) to the specified size
+gcoerceto DF = empty
+gcoerceto  F = 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
@@ -1103,6 +1094,9 @@ pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") DF 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 (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L  src dst
 
@@ -1130,11 +1124,11 @@ Continue with I386-only printing bits and bobs:
 \begin{code}
 pprDollImm :: Imm -> SDoc
 
-pprDollImm i     = hcat [ ptext SLIT("$"), pprImm i]
+pprDollImm i =  ptext SLIT("$") <> pprImm i
 
 pprOperand :: Size -> Operand -> SDoc
-pprOperand s (OpReg r) = pprReg s r
-pprOperand s (OpImm i) = pprDollImm i
+pprOperand s (OpReg r)   = pprReg s r
+pprOperand s (OpImm i)   = pprDollImm i
 pprOperand s (OpAddr ea) = pprAddr ea
 
 pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> SDoc
@@ -1196,6 +1190,16 @@ pprSizeOpReg name size op1 reg
 	pprReg size reg
     ]
 
+pprSizeReg :: FAST_STRING -> Size -> Reg -> SDoc
+pprSizeReg name size reg1
+  = hcat [
+    	char '\t',
+	ptext name,
+    	pprSize size,
+	space,
+	pprReg size reg1
+    ]
+
 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
 pprSizeRegReg name size reg1 reg2
   = hcat [