[MLton] cvs commit: 64-bit moves in x86 codegen

Matthew Fluet fluet@mlton.org
Sat, 22 Jan 2005 08:33:34 -0800


fluet       05/01/22 08:33:33

  Modified:    doc      changelog
               include  x86-main.h
               mlton/codegen/x86-codegen x86-mlton-basic.fun
                        x86-mlton-basic.sig x86-mlton.fun x86-pseudo.sig
                        x86-translate.fun x86.fun x86.sig
  Log:
  MAIL 64-bit moves in x86 codegen
  
  Fixed x86 codegen bug which failed to account for the possibility that
  a 64-bit move could interfere with itself (as simulated by 32-bit
  moves).

Revision  Changes    Path
1.144     +5 -0      mlton/doc/changelog

Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.143
retrieving revision 1.144
diff -u -r1.143 -r1.144
--- changelog	22 Dec 2004 21:27:13 -0000	1.143
+++ changelog	22 Jan 2005 16:33:32 -0000	1.144
@@ -1,5 +1,10 @@
 Here are the changes since version 20041109.
 
+* 2005-01-22
+  - Fixed x86 codegen bug which failed to account for the possibility that
+    a 64-bit move could interfere with itself (as simulated by 32-bit
+    moves).
+	
 * 2004-12-22
   - Fixed Real32.fmt StringCvt.EXACT, which had been producing too
     many digits of precision because it was converting to a



1.18      +32 -26    mlton/include/x86-main.h

Index: x86-main.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/x86-main.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- x86-main.h	12 Oct 2004 21:08:49 -0000	1.17
+++ x86-main.h	22 Jan 2005 16:33:32 -0000	1.18
@@ -4,33 +4,39 @@
 #include "main.h"
 
 /* Globals */
-Word applyFFTemp;
-Word applyFFTemp2;
-Word checkTemp;
-Word cReturnTemp[16];
-Word c_stackP;
-Word divTemp;
-Word eq1Temp;
-Word eq2Temp;
-Word fileTemp;
-Word fildTemp;
-Word fpswTemp;
-Word indexTemp;
-Word intInfTemp;
+Word32 applyFFTemp;
+Word32 applyFFTemp2;
+Word32 checkTemp;
+Word32 cReturnTemp[16];
+Word32 c_stackP;
+Word32 divTemp;
+Word32 eq1Temp;
+Word32 eq2Temp;
+Word32 fileTemp;
+Word32 fildTemp;
+Word32 fpswTemp;
+Word32 indexTemp;
+Word32 intInfTemp;
 char MLton_bug_msg[] = "cps machine";
-Word raTemp1;
-double raTemp2;
-double realTemp1D;
-double realTemp2D;
-double realTemp3D;
-float realTemp1S;
-float realTemp2S;
-float realTemp3S;
-Word spill[16];
-Word stackTopTemp;
-Word statusTemp;
-Word switchTemp;
-Word threadTemp;
+Word32 raTemp1;
+Real64 raTemp2;
+Real64 realTemp1D;
+Real64 realTemp2D;
+Real64 realTemp3D;
+Real32 realTemp1S;
+Real32 realTemp2S;
+Real32 realTemp3S;
+Word32 spill[16];
+Word32 stackTopTemp;
+Word32 statusTemp;
+Word32 switchTemp;
+Word32 threadTemp;
+Word8 wordTemp1B;
+Word8 wordTemp2B;
+Word16 wordTemp1W;
+Word16 wordTemp2W;
+Word32 wordTemp1L;
+Word32 wordTemp2L;
 
 #ifndef DEBUG_X86CODEGEN
 #define DEBUG_X86CODEGEN FALSE



1.33      +56 -0     mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun

Index: x86-mlton-basic.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- x86-mlton-basic.fun	23 Sep 2004 03:12:57 -0000	1.32
+++ x86-mlton-basic.fun	22 Jan 2005 16:33:32 -0000	1.33
@@ -306,6 +306,62 @@
   val eq2TempContentsOperand
     = Operand.memloc eq2TempContents
 
+  val wordTemp1B = Label.fromString "wordTemp1B"
+  val wordTemp1ContentsB
+    = makeContents {base = Immediate.label wordTemp1B,
+		    size = Size.BYTE,
+		    class = Classes.StaticTemp}
+  val wordTemp1ContentsOperandB
+    = Operand.memloc wordTemp1ContentsB
+  val wordTemp1W = Label.fromString "wordTemp1W"
+  val wordTemp1ContentsW
+    = makeContents {base = Immediate.label wordTemp1W,
+		    size = Size.WORD,
+		    class = Classes.StaticTemp}
+  val wordTemp1ContentsOperandW
+    = Operand.memloc wordTemp1ContentsW
+  val wordTemp1L = Label.fromString "wordTemp1L"
+  val wordTemp1ContentsL
+    = makeContents {base = Immediate.label wordTemp1L,
+		    size = Size.LONG,
+		    class = Classes.StaticTemp}
+  val wordTemp1ContentsOperandL
+    = Operand.memloc wordTemp1ContentsL
+  fun wordTemp1ContentsOperand wordSize
+    = case wordSize of
+        Size.BYTE => wordTemp1ContentsOperandB
+      | Size.WORD => wordTemp1ContentsOperandW
+      | Size.LONG => wordTemp1ContentsOperandL
+      | _ => Error.bug "wordTemp1ContentsOperand: wordSize"
+
+  val wordTemp2B = Label.fromString "wordTemp2B"
+  val wordTemp2ContentsB
+    = makeContents {base = Immediate.label wordTemp2B,
+		    size = Size.BYTE,
+		    class = Classes.StaticTemp}
+  val wordTemp2ContentsOperandB
+    = Operand.memloc wordTemp2ContentsB
+  val wordTemp2W = Label.fromString "wordTemp2W"
+  val wordTemp2ContentsW
+    = makeContents {base = Immediate.label wordTemp2W,
+		    size = Size.WORD,
+		    class = Classes.StaticTemp}
+  val wordTemp2ContentsOperandW
+    = Operand.memloc wordTemp2ContentsW
+  val wordTemp2L = Label.fromString "wordTemp2L"
+  val wordTemp2ContentsL
+    = makeContents {base = Immediate.label wordTemp2L,
+		    size = Size.LONG,
+		    class = Classes.StaticTemp}
+  val wordTemp2ContentsOperandL
+    = Operand.memloc wordTemp2ContentsL
+  fun wordTemp2ContentsOperand wordSize
+    = case wordSize of
+        Size.BYTE => wordTemp2ContentsOperandB
+      | Size.WORD => wordTemp2ContentsOperandW
+      | Size.LONG => wordTemp2ContentsOperandL
+      | _ => Error.bug "wordTemp2ContentsOperand: wordSize"
+
 
   local
      fun make prefix =



1.33      +2 -0      mlton/mlton/codegen/x86-codegen/x86-mlton-basic.sig

Index: x86-mlton-basic.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton-basic.sig,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- x86-mlton-basic.sig	23 Sep 2004 03:12:57 -0000	1.32
+++ x86-mlton-basic.sig	22 Jan 2005 16:33:32 -0000	1.33
@@ -96,6 +96,8 @@
     val statusTempContentsOperand : x86.Operand.t
     val eq1TempContentsOperand : x86.Operand.t
     val eq2TempContentsOperand : x86.Operand.t
+    val wordTemp1ContentsOperand : x86.Size.t -> x86.Operand.t
+    val wordTemp2ContentsOperand : x86.Size.t -> x86.Operand.t
 
     (* Static arrays defined in main.h and x86-main.h *)
     val local_base : x86.CType.t -> x86.Label.t



1.65      +66 -14    mlton/mlton/codegen/x86-codegen/x86-mlton.fun

Index: x86-mlton.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.fun,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- x86-mlton.fun	12 Jan 2005 21:56:01 -0000	1.64
+++ x86-mlton.fun	22 Jan 2005 16:33:32 -0000	1.65
@@ -284,28 +284,46 @@
 			    src2size = dst2size andalso
 		            src4size = dst2size andalso
 		            dst1size = dst2size)
+	      val tdst1 =
+		 if List.exists ([src2,src3,src4], fn src =>
+				 Operand.mayAlias (dst1, src))
+		    then wordTemp1ContentsOperand dst1size
+		    else dst1
+	      val tdst2 =
+		 if List.exists ([src3,src4], fn src =>
+				 Operand.mayAlias (dst2, src))
+		    then wordTemp1ContentsOperand dst2size
+		    else dst2
 	    in
 	      AppendList.fromList
 	      [Block.mkBlock'
 	       {entry = NONE,
 		statements
 		= [Assembly.instruction_mov
-		   {dst = dst1,
+		   {dst = tdst1,
 		    src = src1,
 		    size = src1size},
 		   Assembly.instruction_mov
-		   {dst = dst2,
+		   {dst = tdst2,
 		    src = src2,
 		    size = src2size},
 		   Assembly.instruction_binal
 		   {oper = oper1,
-		    dst = dst1,
+		    dst = tdst1,
 		    src = src3,
 		    size = dst1size},
 		   Assembly.instruction_binal
 		   {oper = oper2,
-		    dst = dst2,
+		    dst = tdst2,
 		    src = src4,
+		    size = dst2size},
+		   Assembly.instruction_mov
+		   {dst = dst1,
+		    src = tdst1,
+		    size = dst1size},
+		   Assembly.instruction_mov
+		   {dst = dst2,
+		    src = tdst2,
 		    size = dst2size}],
 		transfer = NONE}]
 	    end
@@ -427,19 +445,28 @@
 		   fn () => src1size = dst1size andalso
                             src2size = dst2size andalso
                             dst1size = dst2size)
+	      val tdst1 =
+		 if List.exists ([src2], fn src =>
+				 Operand.mayAlias (dst1, src))
+		    then wordTemp1ContentsOperand dst1size
+		    else dst1
 	    in
 	      AppendList.fromList
 	      [Block.mkBlock'
 	       {entry = NONE,
 		statements 
 		= [Assembly.instruction_mov
-		   {dst = dst1,
+		   {dst = tdst1,
 		    src = src1,
 		    size = src1size},
 		   Assembly.instruction_mov
 		   {dst = dst2,
 		    src = src2,
 		    size = src2size},
+		   Assembly.instruction_mov
+		   {dst = dst1,
+		    src = tdst1,
+		    size = dst1size},
 		   Assembly.instruction_unal
 		   {oper = oper,
 		    dst = dst1,
@@ -509,8 +536,7 @@
 				   src2 = src1,
 				   size = src1size},
 				  Assembly.instruction_setcc
-				  {condition 
-				   = Instruction.condition_reverse condition,
+				  {condition = Instruction.condition_reverse condition,
 				   dst = dst,
 				   size = dstsize}],
 			       transfer = NONE}]
@@ -1524,24 +1550,42 @@
 		       fn () => src1size = dst1size andalso src3size = dst1size andalso
                                 src2size = dst2size andalso src4size = dst2size andalso
                                 dst1size = dst2size)
+	      val tdst1 =
+		 if List.exists ([src2,src3,src4], fn src =>
+				 Operand.mayAlias (dst1, src))
+		    then wordTemp1ContentsOperand dst1size
+		    else dst1
+	      val tdst2 =
+		 if List.exists ([src3,src4], fn src =>
+				 Operand.mayAlias (dst2, src))
+		    then wordTemp1ContentsOperand dst2size
+		    else dst2
 	    in
 	      check ([Assembly.instruction_mov
-		      {dst = dst1,
+		      {dst = tdst1,
 		       src = src1,
 		       size = dst1size},
 		      Assembly.instruction_mov
-		      {dst = dst2,
+		      {dst = tdst2,
 		       src = src2,
 		       size = dst2size},
 		      Assembly.instruction_binal
 		      {oper = oper1,
-		       dst = dst1,
+		       dst = tdst1,
 		       src = src3,
 		       size = dst1size},
 		      Assembly.instruction_binal
 		      {oper = oper2,
-		       dst = dst2,
+		       dst = tdst2,
 		       src = src4,
+		       size = dst2size},
+		      Assembly.instruction_mov
+		      {dst = dst1,
+		       src = tdst1,
+		       size = dst1size},
+		      Assembly.instruction_mov
+		      {dst = dst2,
+		       src = tdst2,
 		       size = dst2size}],
 		     condition)
 	    end
@@ -1607,6 +1651,11 @@
 		       fn () => src1size = dst1size andalso
 		                src2size = dst2size andalso
 				dst1size = dst2size)
+	      val tdst1 =
+		 if List.exists ([src2], fn src =>
+				 Operand.mayAlias (dst1, src))
+		    then wordTemp1ContentsOperand dst1size
+		    else dst1
 	      val loZ = Label.newString "loZ"
 	      val _ = x86Liveness.LiveInfo.setLiveOperands
 		      (liveInfo, loZ, dst2::((live success) @ (live overflow)))
@@ -1618,13 +1667,17 @@
 	       [x86.Block.mkBlock'
 		{entry = NONE,
 		 statements = [Assembly.instruction_mov
-			       {dst = dst1,
+			       {dst = tdst1,
 				src = src1,
 				size = dst1size},
 			       Assembly.instruction_mov
 			       {dst = dst2,
 				src = src2,
 				size = dst2size},
+			       Assembly.instruction_mov
+			       {dst = dst1,
+				src = tdst1,
+				size = dst1size},
 			       Assembly.instruction_unal 
 			       {oper = x86.Instruction.NEG,
 				dst = dst1,
@@ -1723,8 +1776,7 @@
 		      W8 => binal (x86.Instruction.ADD, flag)
 		    | W16 => binal (x86.Instruction.ADD, flag)
 		    | W32 => binal (x86.Instruction.ADD, flag)
-		    | W64 =>
-			 binal64 (x86.Instruction.ADD, x86.Instruction.ADC, flag)
+		    | W64 => binal64 (x86.Instruction.ADD, x86.Instruction.ADC, flag)
 		end
 	   | Word_mulCheck (s, {signed}) =>
 		let



1.25      +1 -0      mlton/mlton/codegen/x86-codegen/x86-pseudo.sig

Index: x86-pseudo.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-pseudo.sig,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- x86-pseudo.sig	23 Sep 2004 03:12:58 -0000	1.24
+++ x86-pseudo.sig	22 Jan 2005 16:33:33 -0000	1.25
@@ -158,6 +158,7 @@
 
 	val size : t -> Size.t option
 	val eq : t * t -> bool
+	val mayAlias : t * t -> bool
       end
 
     structure Instruction : 



1.66      +12 -0     mlton/mlton/codegen/x86-codegen/x86-translate.fun

Index: x86-translate.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-translate.fun,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- x86-translate.fun	14 Aug 2004 01:34:52 -0000	1.65
+++ x86-translate.fun	22 Jan 2005 16:33:33 -0000	1.66
@@ -425,6 +425,18 @@
 		     
 		   val dsts = Operand.toX86Operand dst
 		   val srcs = Operand.toX86Operand src
+		   (* Operand.toX86Operand returns multi-word 
+		    * operands in and they will be moved in order,
+		    * so it suffices to check for aliasing between 
+		    * the first dst and second src.
+		    *)
+		   val (dsts,srcs) =
+		      if Vector.length srcs > 1
+			 andalso x86.Operand.mayAlias
+			         (#1 (Vector.sub (dsts, 0)), 
+				  #1 (Vector.sub (srcs, 1)))
+			 then (Vector.rev dsts, Vector.rev srcs)
+			 else (dsts,srcs)
 		 in
 		   AppendList.appends
 		   [comment_begin,



1.59      +16 -0     mlton/mlton/codegen/x86-codegen/x86.fun

Index: x86.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.fun,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -r1.58 -r1.59
--- x86.fun	22 Dec 2004 05:11:25 -0000	1.58
+++ x86.fun	22 Jan 2005 16:33:33 -0000	1.59
@@ -1359,6 +1359,22 @@
 	   | (MemLoc m1,      MemLoc m2)      => MemLoc.eq(m1, m2)
 	   | _                                => false
 
+      val mayAlias
+	= fn (Register r1,    Register r2)    => Register.eq(r1, r2)
+	   | (Register r1,    _)              => false
+	   | (FltRegister f1, FltRegister f2) => FltRegister.eq(f1, f2)
+	   | (FltRegister f1, _)              => false
+	   | (Immediate i1,   Immediate i2)   => Immediate.eq(i1, i2)
+           | (Immediate i1,   _)              => false
+	   | (Label l1,       Label l2)       => Label.equals(l1, l2)
+	   | (Label l1,       _)              => false
+	   | (Address a1,     Address a2)     => true
+	   | (Address a1,     MemLoc m2)      => true
+           | (Address a1,     _)              => false
+	   | (MemLoc m1,      MemLoc m2)      => MemLoc.mayAlias(m1, m2)
+	   | (MemLoc m1,      Address a2)     => true
+	   | (MemLoc m1,      _)              => false
+
       val register = Register
       val deRegister
 	= fn Register x => SOME x



1.34      +1 -0      mlton/mlton/codegen/x86-codegen/x86.sig

Index: x86.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.sig,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- x86.sig	23 Sep 2004 03:12:59 -0000	1.33
+++ x86.sig	22 Jan 2005 16:33:33 -0000	1.34
@@ -310,6 +310,7 @@
 
 	val size : t -> Size.t option
 	val eq : t * t -> bool
+	val mayAlias : t * t -> bool
 
 	val cReturnTemps: RepType.t -> {src: t, dst: MemLoc.t} list
       end