[MLton-devel] cvs commit: Word64 beginnings

Stephen Weeks sweeks@users.sourceforge.net
Tue, 09 Sep 2003 18:00:12 -0700


sweeks      03/09/09 18:00:12

  Modified:    mlton    mlton-stubs-1997.cm mlton-stubs.cm mlton.cm
               mlton/ast prim-tycons.fun word-size.fun word-size.sig
               mlton/atoms const.fun prim.fun word-x.fun word-x.sig
               mlton/backend backend.fun limit-check.fun profile.fun
                        rssa.fun ssa-to-rssa.fun
               mlton/codegen/c-codegen c-codegen.fun
               mlton/codegen/x86-codegen x86-mlton.fun x86-translate.fun
                        x86.fun
               mlton/ssa type-check.fun
               mlton/type-inference infer.fun match-compile.fun
  Log:
  Preparation for adding Word64 to the basis.
  
  Added new WordSize.t W64.
  
  Use LargeWord instead of Word for representing word constants.
  
  Added code to the match compiler so that cases of Word64's will be
  treated like Int64's and will generate cascading if tests.
  
  Added lots of Error.bug "FIXME"'s to the x86 codegen where it might
  encounter W64 primitives.

Revision  Changes    Path
1.25      +1 -0      mlton/mlton/mlton-stubs-1997.cm

Index: mlton-stubs-1997.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/mlton-stubs-1997.cm,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- mlton-stubs-1997.cm	21 Jul 2003 21:53:50 -0000	1.24
+++ mlton-stubs-1997.cm	10 Sep 2003 01:00:07 -0000	1.25
@@ -146,6 +146,7 @@
 control/region.sig
 control/region.sml
 ../lib/mlton/set/set.sig
+../lib/mlton/basic/large-word.sml
 ast/word-size.sig
 ast/wrapped.sig
 ast/tyvar.sig



1.30      +1 -0      mlton/mlton/mlton-stubs.cm

Index: mlton-stubs.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/mlton-stubs.cm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- mlton-stubs.cm	21 Jul 2003 21:53:50 -0000	1.29
+++ mlton-stubs.cm	10 Sep 2003 01:00:07 -0000	1.30
@@ -145,6 +145,7 @@
 control/region.sig
 control/region.sml
 ../lib/mlton/set/set.sig
+../lib/mlton/basic/large-word.sml
 ast/word-size.sig
 ast/wrapped.sig
 ast/tyvar.sig



1.72      +1 -0      mlton/mlton/mlton.cm

Index: mlton.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/mlton.cm,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- mlton.cm	21 Jul 2003 21:53:50 -0000	1.71
+++ mlton.cm	10 Sep 2003 01:00:07 -0000	1.72
@@ -112,6 +112,7 @@
 control/region.sig
 control/region.sml
 ../lib/mlton/set/set.sig
+../lib/mlton/basic/large-word.sml
 ast/word-size.sig
 ast/wrapped.sig
 ast/tyvar.sig



1.7       +5 -2      mlton/mlton/ast/prim-tycons.fun

Index: prim-tycons.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/prim-tycons.fun,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- prim-tycons.fun	23 Jun 2003 04:58:55 -0000	1.6
+++ prim-tycons.fun	10 Sep 2003 01:00:08 -0000	1.7
@@ -39,6 +39,7 @@
 val word8 = fromString "word8"
 val word16 = fromString "word16"
 val word32 = fromString "word32"
+val word64 = fromString "word64"
 
 val ints =
    [(int8, I8),
@@ -53,7 +54,8 @@
 val words =
    [(word8, W8),
     (word16, W16),
-    (word32, W32)]
+    (word32, W32),
+    (word64, W64)]
    
 val prims =
    [array, arrow, bool, char, exn,
@@ -61,7 +63,7 @@
     list, pointer, preThread,
     real32, real64,
     reff, thread, tuple, vector, weak,
-    word8, word16, word32]
+    word8, word16, word32, word64]
    
 val int =
    fn I8 => int8
@@ -77,6 +79,7 @@
    fn W8 => word8
     | W16 => word16
     | W32 => word32
+    | W64 => word64
 	 
 val defaultInt = int IntSize.default
 val defaultReal = real RealSize.default



1.2       +19 -6     mlton/mlton/ast/word-size.fun

Index: word-size.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- word-size.fun	23 Jun 2003 04:58:55 -0000	1.1
+++ word-size.fun	10 Sep 2003 01:00:08 -0000	1.2
@@ -1,18 +1,28 @@
 functor WordSize (S: WORD_SIZE_STRUCTS): WORD_SIZE =
 struct
 
-datatype t = W8 | W16 | W32
+datatype t = W8 | W16 | W32 | W64
 
 val equals: t * t -> bool = op =
 
-val all = [W8, W16, W32]
+val all = [W8, W16, W32, W64]
 
 val default = W32
 
-val max: t -> word =
-   fn W8 => 0wxFF
-    | W16 => 0wxFFFF
-    | W32 => 0wxFFFFFFFF
+val max: t -> LargeWord.t =
+   fn W8 => Word.toLarge 0wxFF
+    | W16 => Word.toLarge 0wxFFFF
+    | W32 => Word.toLarge 0wxFFFFFFFF
+    | W64 =>
+	 (* Would like to write 0wxFFFFFFFFFFFFFFFF, but can't because SML/NJ
+	  * doesn't have 64 bit words.
+	  *)
+	 let
+	    open LargeWord
+	 in
+	    orb (<< (fromWord 0wxFFFFFFFF, 0w32),
+		 fromWord 0wxFFFFFFFF)
+	 end
 
 val allOnes = max
 
@@ -20,6 +30,7 @@
    fn W8 => 1
     | W16 => 2
     | W32 => 4
+    | W64 => 8
 
 fun size s = 8 * bytes s
 
@@ -31,10 +42,12 @@
       val a8 = f W8
       val a16 = f W16
       val a32 = f W32
+      val a64 = f W64
    in
       fn W8 => a8
        | W16 => a16
        | W32 => a32
+       | W64 => a64
    end
    
 end



1.2       +3 -3      mlton/mlton/ast/word-size.sig

Index: word-size.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/word-size.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- word-size.sig	23 Jun 2003 04:58:55 -0000	1.1
+++ word-size.sig	10 Sep 2003 01:00:08 -0000	1.2
@@ -9,14 +9,14 @@
    sig
       include WORD_SIZE_STRUCTS
 	 
-      datatype t = W8 | W16 | W32
+      datatype t = W8 | W16 | W32 | W64
 
       val all: t list
-      val allOnes: t -> word
+      val allOnes: t -> LargeWord.t
       val bytes: t -> int
       val default: t
       val equals: t * t -> bool
-      val max: t -> word
+      val max: t -> LargeWord.t
       val memoize: (t -> 'a) -> t -> 'a
       val size: t -> int
       val toString: t -> string



1.10      +1 -1      mlton/mlton/atoms/const.fun

Index: const.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.fun,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- const.fun	2 Jul 2003 15:08:16 -0000	1.9
+++ const.fun	10 Sep 2003 01:00:08 -0000	1.10
@@ -96,7 +96,7 @@
 	 Int i => String.hash (IntX.toString i)
        | IntInf i => String.hash (IntInf.toString i)
        | Real r => RealX.hash r
-       | Word w => WordX.toWord w
+       | Word w => LargeWord.toWord (WordX.toLargeWord w)
        | Word8Vector v => String.hash (Word8.vectorToString v)
 end
    



1.62      +12 -6     mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- prim.fun	5 Sep 2003 21:30:14 -0000	1.61
+++ prim.fun	10 Sep 2003 01:00:08 -0000	1.62
@@ -931,7 +931,8 @@
 	   | (IntInf_toWord, [IntInf i]) =>
 		(case SmallIntInf.toWord i of
 		    NONE => ApplyResult.Unknown
-		  | SOME w => word (WordX.make (w, WordSize.default)))
+		  | SOME w => word (WordX.make (LargeWord.fromWord w,
+						WordSize.default)))
 	   | (MLton_eq, [c1, c2]) => eq (c1, c2)
 	   | (MLton_equal, [c1, c2]) => equal (c1, c2)
 	   | (Word_add _, [Word w1, Word w2]) => word (WordX.+ (w1, w2))
@@ -959,7 +960,8 @@
 	   | (Word_toInt (_, s), [Word w]) =>
 		int (IntX.make (WordX.toIntInf w, s))
 	   | (Word_toIntInf, [Word w]) =>
-		intInf (SmallIntInf.fromWord (WordX.toWord w))
+		intInf (SmallIntInf.fromWord
+			(LargeWord.toWord (WordX.toLargeWord w)))
 	   | (Word_toIntX (_, s), [Word w]) =>
 		int (IntX.make (WordX.toIntInfX w, s))
 	   | (Word_toWord (_, s), [Word w]) => word (WordX.resize (w, s))
@@ -1050,7 +1052,7 @@
 				 (WordX.mod
 				  (w,
 				   WordX.make
-				   (Word.fromInt (WordSize.size s), s)))
+				   (LargeWord.fromInt (WordSize.size s), s)))
 				 then Var x
 			      else Unknown
 			   end
@@ -1063,7 +1065,7 @@
 			then if WordX.isZero w
 				then Var x
 			     else if (WordX.>=
-				      (w, WordX.make (Word.fromInt
+				      (w, WordX.make (LargeWord.fromInt
 						      (WordSize.size s),
 						      WordSize.default)))
 				     then zero s
@@ -1223,8 +1225,12 @@
 		    | _ => Unknown)
 	     | (_, [Const (IntInf i1), Const (Word w2), _]) =>
 		  (case name of
-		      IntInf_arshift => intInf (IntInf.~>> (i1, WordX.toWord w2))
-		    | IntInf_lshift => intInf (IntInf.<< (i1, WordX.toWord w2))
+		      IntInf_arshift =>
+			 intInf (IntInf.~>>
+				 (i1, LargeWord.toWord (WordX.toLargeWord w2)))
+		    | IntInf_lshift =>
+			 intInf (IntInf.<<
+				 (i1, LargeWord.toWord (WordX.toLargeWord w2)))
 		    | _ => Unknown)
 	     | (_, [Const (IntInf i1), _]) =>
 		  (case name of



1.2       +53 -43    mlton/mlton/atoms/word-x.fun

Index: word-x.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/word-x.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- word-x.fun	23 Jun 2003 04:58:55 -0000	1.1
+++ word-x.fun	10 Sep 2003 01:00:09 -0000	1.2
@@ -3,12 +3,15 @@
 
 open S
 
+structure PWord = Word
+structure Word = LargeWord
+   
 datatype z = datatype WordSize.t
    
 (* Words are stored with all zeros for the unused bits. *)
 local
    datatype t = T of {size: WordSize.t,
-		      word: word}
+		      word: Word.t}
 in
    type t = t
    fun make (w, s) =
@@ -24,9 +27,9 @@
    val word = make #word
 end
 
-val toWord = word
+val toLargeWord = word
 
-fun fromWord8 w = make (Word8.toWord w, W8)
+fun fromWord8 w = make (Word8.toLarge w, W8)
 
 fun equals (w, w') = dest w = dest w'
 
@@ -40,53 +43,51 @@
 val layout = Layout.str o toString
 
 fun fromChar (c: Char.t) =
-   make (Word8.toWord (Word8.fromChar c), WordSize.W8)
+   make (Word8.toLarge (Word8.fromChar c), WordSize.W8)
 
-fun signExtend (w: t): word =
+fun signExtend (w: t): Word.t =
    let
       val {size = s, word = w} = dest w
+      fun check (w', w'') =
+	 if Word.fromWord 0w0 = Word.andb (w, Word.fromWord w')
+	    then w
+	 else Word.orb (w, Word.xorb (Word.~ (Word.fromWord 0w1),
+				      Word.fromWord w''))
    in
       case s of
-	 W8 => if 0w0 = Word.andb (w, 0wx80)
-		  then w
-	       else Word.orb (w, 0wxFFFFFF00)
-       | W16 => if 0w0 = Word.andb (w, 0wx8000)
-		   then w
-		else Word.orb (w, 0wxFFFF0000)
-       | W32 => w
+	 W8 => check (0wx80, 0wxFF)
+       | W16 => check (0wx8000, 0wxFFFF)
+       | W32 => check (0wx80000000, 0wxFFFFFFFF)
+       | W64 => w
    end
 
 fun ~>> (w, w') =
-   make (Word.~>> (signExtend w, word w'), size w)
+   make (Word.~>> (signExtend w,
+		   Word.toWord (word w')),
+	 size w)
 
 fun rol (w, w') =
    let
       val {size = s, word = w} = dest w
       val {word = w', ...} = dest w'
+      val n = Word.fromInt (WordSize.size s)
+      val w' = Word.mod (w', n)
    in
-      make (let
-	       open Word
-	       val s = Word.fromInt (WordSize.size s)
-	       val w' = w' mod s
-	    in
-	       orb (>> (w, s - w'), << (w, w'))
-	    end,
-	       s)
+      make (Word.orb (Word.>> (w, Word.toWord (Word.- (n, w'))),
+		      Word.<< (w, Word.toWord w')),
+	    s)
    end
 
 fun ror (w, w') =
    let
       val {size = s, word = w} = dest w
       val {word = w', ...} = dest w'
+      val n = Word.fromInt (WordSize.size s)
+      val w' = Word.mod (w', n)
    in
-      make (let
-	       open Word
-	       val s = Word.fromInt (WordSize.size s)
-	       val w' = w' mod s
-	    in
-	       orb (>> (w, w'), << (w, s - w'))
-	    end,
-	       s)
+      make (Word.orb (Word.>> (w, Word.toWord w'),
+		      Word.<< (w, Word.toWord (Word.- (n, w')))),
+	    s)
    end
 
 fun resize (w, s) = make (word w, s)
@@ -100,7 +101,7 @@
 fun toIntInfX w = Word.toIntInfX (signExtend w)
 
 local
-   val make: (word * word -> word) -> t * t -> t =
+   val make: (Word.t * Word.t -> Word.t) -> t * t -> t =
       fn f => fn (w, w') =>
       let
 	 val {size = s, word = w} = dest w
@@ -112,8 +113,6 @@
    val op + = make Word.+
    val op - = make Word.-
    val op * = make Word.*
-   val << = make Word.<<
-   val >> = make Word.>>
    val andb = make Word.andb
    val op div = make Word.div
    val op mod = make Word.mod
@@ -123,33 +122,44 @@
 
 fun notb w = make (Word.notb (word w), size w)
 
-fun isOne w = 0w1 = word w
+fun isOne w = Word.fromWord 0w1 = word w
 	 
-fun isZero w = 0w0 = word w
+fun isZero w = Word.fromWord 0w0 = word w
 
 fun isAllOnes w = word w = WordSize.allOnes (size w)
 
 fun isMax w = word w = WordSize.max (size w)
 
-fun one s = make (0w1, s)
+fun one s = make (Word.fromWord 0w1, s)
    
-fun zero s = make (0w0, s)
+fun zero s = make (Word.fromWord 0w0, s)
 
 fun allOnes s = make (WordSize.allOnes s, s)
 
 fun max s = make (WordSize.max s, s)
 
-fun toChar w =
+fun toChar (w: t): char =
    let
       val {word = w, ...} = dest w
    in
-      Word8.toChar (Word8.fromWord w)
+      Word.toChar w
    end
 
 val toString = Word.toString o word
 
 local
-   fun make (f: word * word -> 'a): t * t -> 'a =
+   fun wrap (f: Word.t * PWord.t -> Word.t) (w: t, w': t): t =
+      if Word.> (word w', Word.fromInt (WordSize.size (size w)))
+	 then zero (size w)
+      else make (f (word w, Word.toWord (word w')),
+		 size w)
+in
+   val << = wrap Word.<<
+   val >> = wrap Word.>>
+end
+
+local
+   fun make (f: Word.t * Word.t -> 'a): t * t -> 'a =
       fn (w, w') =>
       let
 	 val {size = s, word = w} = dest w
@@ -160,10 +170,10 @@
 	 else Error.bug "WordX binary failure"
       end
 in
-   val op < = make (op <)
-   val op <= = make (op <=)
-   val op > = make (op >)
-   val op >= = make (op >=)
+   val op < = make Word.<
+   val op <= = make Word.<=
+   val op > = make Word.>
+   val op >= = make Word.>=
 end
 
 end



1.2       +2 -2      mlton/mlton/atoms/word-x.sig

Index: word-x.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/word-x.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- word-x.sig	23 Jun 2003 04:58:55 -0000	1.1
+++ word-x.sig	10 Sep 2003 01:00:09 -0000	1.2
@@ -34,7 +34,7 @@
       val isMax: t -> bool
       val isZero: t -> bool
       val layout: t -> Layout.t
-      val make: word * WordSize.t -> t
+      val make: LargeWord.t * WordSize.t -> t
       val max: WordSize.t -> t
       val mod: t * t -> t
       val notb: t -> t
@@ -48,8 +48,8 @@
       val toChar: t -> char
       val toIntInf: t -> IntInf.t
       val toIntInfX: t -> IntInf.t
+      val toLargeWord: t -> LargeWord.t
       val toString: t -> string
-      val toWord: t -> word
       val xorb: t * t -> t
       val zero: WordSize.t -> t
    end



1.58      +2 -1      mlton/mlton/backend/backend.fun

Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- backend.fun	19 Jul 2003 01:23:26 -0000	1.57
+++ backend.fun	10 Sep 2003 01:00:09 -0000	1.58
@@ -450,7 +450,8 @@
 				    ty = ty}
 	     | PointerTycon pt =>
 		  M.Operand.Word
-		  (WordX.make (Runtime.typeIndexToHeader (PointerTycon.index pt),
+		  (WordX.make (Word.toLarge (Runtime.typeIndexToHeader
+					     (PointerTycon.index pt)),
 			       WordSize.default))
 	     | Runtime f =>
 		  runtimeOp (f, R.Operand.ty oper)



1.40      +9 -5      mlton/mlton/backend/limit-check.fun

Index: limit-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/limit-check.fun,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- limit-check.fun	19 Jul 2003 01:23:26 -0000	1.39
+++ limit-check.fun	10 Sep 2003 01:00:09 -0000	1.40
@@ -170,7 +170,8 @@
 					  Operand.EnsuresBytesFree =>
 					     Operand.word
 					     (WordX.make
-					      (ensureBytesFree (valOf return),
+					      (Word.toLarge
+					       (ensureBytesFree (valOf return)),
 					       WordSize.default))
 					| _ => z)),
 			      func = func,
@@ -367,7 +368,7 @@
 				       insert (Operand.word
 					       (WordX.zero WordSize.default)))
 		else heapCheck (true,
-				Operand.word (WordX.make (bytes,
+				Operand.word (WordX.make (Word.toLarge bytes,
 							  WordSize.default)))
 	     fun smallAllocation _ =
 		let
@@ -388,7 +389,9 @@
 			 (case c of
 			     Const.Word w =>
 				heapCheckNonZero
-				(MLton.Word.addCheck (WordX.toWord w, extraBytes)
+				(MLton.Word.addCheck
+				 (Word.fromLarge (WordX.toLargeWord w),
+				  extraBytes)
 				 handle Overflow => Runtime.allocTooLarge)
 			   | _ => Error.bug "strange primitive bytes needed")
 		    | _ =>
@@ -400,8 +403,9 @@
 			     Vector.new0 (),
 			     Transfer.Arith
 			     {args = Vector.new2 (Operand.word
-						  (WordX.make (extraBytes,
-							       WordSize.default)),
+						  (WordX.make
+						   (Word.toLarge extraBytes,
+						    WordSize.default)),
 						  bytesNeeded),
 			      dst = bytes,
 			      overflow = allocTooLarge (),



1.29      +2 -1      mlton/mlton/backend/profile.fun

Index: profile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/profile.fun,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- profile.fun	7 Jul 2003 22:50:28 -0000	1.28
+++ profile.fun	10 Sep 2003 01:00:09 -0000	1.29
@@ -512,7 +512,8 @@
 						(Operand.GCState,
 						 Operand.word
 						 (WordX.make
-						  (Word.fromInt bytesAllocated,
+						  (LargeWord.fromInt
+						   bytesAllocated,
 						   WordSize.default)))),
 					func = func,
 					return = SOME newLabel}



1.35      +1 -1      mlton/mlton/backend/rssa.fun

Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- rssa.fun	19 Jul 2003 01:23:26 -0000	1.34
+++ rssa.fun	10 Sep 2003 01:00:10 -0000	1.35
@@ -139,7 +139,7 @@
 		      (* 512 is pretty arbitrary *)
 		      if WordX.<= (w, WordX.fromLargeInt (IntInf.fromInt 512,
 							  WordX.size w))
-			 then small (WordX.toWord w)
+			 then small (LargeWord.toWord (WordX.toLargeWord w))
 		      else big z
 		 | _ => Error.bug "strange numBytes")
 	  | _ => big z



1.47      +4 -3      mlton/mlton/backend/ssa-to-rssa.fun

Index: ssa-to-rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/ssa-to-rssa.fun,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- ssa-to-rssa.fun	5 Sep 2003 23:19:24 -0000	1.46
+++ ssa-to-rssa.fun	10 Sep 2003 01:00:10 -0000	1.47
@@ -1022,7 +1022,7 @@
 					(Operand.Cast (addr, Type.defaultWord),
 					 Operand.word
 					 (WordX.make
-					  (Word.fromInt
+					  (LargeWord.fromInt
 					   (!Control.cardSizeLog2),
 					   WordSize.default)))),
 				dst = SOME (index, Type.defaultInt),
@@ -1068,7 +1068,8 @@
 							      Type.defaultWord),
 					        Operand.word
 						(WordX.make
-						 (Word.fromInt (Type.size ty),
+						 (LargeWord.fromInt
+						  (Type.size ty),
 						  WordSize.default))),
 				        dst = SOME (temp, Type.defaultWord),
 				        prim = Prim.wordMul WordSize.default})
@@ -1254,7 +1255,7 @@
 						 Operand.Runtime LimitPlusSlop,
 						 Operand.word
 						 (WordX.make
-						  (Word.fromInt
+						  (LargeWord.fromInt
 						   Runtime.limitSlop,
 						   WordSize.default)))
 					val l' =



1.68      +1 -0      mlton/mlton/codegen/c-codegen/c-codegen.fun

Index: c-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.fun,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -r1.67 -r1.68
--- c-codegen.fun	29 Aug 2003 00:25:20 -0000	1.67
+++ c-codegen.fun	10 Sep 2003 01:00:10 -0000	1.68
@@ -129,6 +129,7 @@
 	       W8 => simple "8"
 	     | W16 => simple "16"
 	     | W32 => concat ["0x", toString w]
+	     | W64 => simple "64"
 	 end
    end
    



1.50      +17 -6     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.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- x86-mlton.fun	31 Jul 2003 23:10:33 -0000	1.49
+++ x86-mlton.fun	10 Sep 2003 01:00:11 -0000	1.50
@@ -740,15 +740,19 @@
 		end
 	     | Int_toWord (s, s') =>
 		(case (s, s') of
-		    (I64, W32) => Error.bug "FIXME"
+		    (I64, W64) => Error.bug "FIXME"
+		  | (I64, W32) => Error.bug "FIXME"
 		  | (I64, W16) => Error.bug "FIXME"
 		  | (I64, W8) => Error.bug "FIXME"
+		  | (I32, W64) => Error.bug "FIXME"
 		  | (I32, W32) => mov ()
 		  | (I32, W16) => xvom ()
 		  | (I32, W8) => xvom ()
+		  | (I16, W64) => Error.bug "FIXME"
 		  | (I16, W32) => movx Instruction.MOVSX
 		  | (I16, W16) => mov ()
 		  | (I16, W8) => xvom ()
+		  | (I8, W64) => Error.bug "FIXME"
 		  | (I8, W32) => movx Instruction.MOVSX
 		  | (I8, W16) => movx Instruction.MOVSX
 		  | (I8, W8) => mov ())
@@ -1344,7 +1348,8 @@
 		  (case s of
 		      W8 => pmd Instruction.MUL
 		    | W16 => imul2 ()
-		    | W32 => imul2 ())
+		    | W32 => imul2 ()
+		    | W64 => Error.bug "FIXME")
 	     | Word_neg _ => unal Instruction.NEG
 	     | Word_notb _ => unal Instruction.NOT
 	     | Word_orb _ => binal Instruction.OR
@@ -1366,7 +1371,8 @@
 		 | _ => Error.bug (Prim.toString prim))
 	     | Word_toIntX (s, s') =>
 		(case (s, s') of
-		   (W32, I32) => mov ()
+		   (W64, _) => Error.bug "FIXME"
+		 | (W32, I32) => mov ()
 		 | (W32, I16) => xvom ()
 		 | (W32, I8) => xvom ()
 		 | (W16, I32) => movx Instruction.MOVSX
@@ -1378,7 +1384,9 @@
 		 | _ => Error.bug (Prim.toString prim))
 	     | Word_toWord (s, s') =>
 	        (case (s, s') of
-		   (W32, W32) => mov ()
+		   (W64, _) => Error.bug "FIXME"
+		 | (_, W64) => Error.bug "FIXME"
+		 | (W32, W32) => mov ()
 		 | (W32, W16) => xvom ()
 		 | (W32, W8) => xvom ()
 		 | (W16, W32) => movx Instruction.MOVZX
@@ -1389,7 +1397,9 @@
 		 | (W8, W8) => mov ())
 	     | Word_toWordX (s, s') =>
 		(case (s, s') of
-		   (W32, W32) => mov ()
+		    (W64, _) => Error.bug "FIXME"
+		  | (_, W64) => Error.bug "FIXME"
+		  | (W32, W32) => mov ()
 		 | (W32, W16) => xvom ()
 		 | (W32, W8) => xvom ()
 		 | (W16, W32) => movx Instruction.MOVSX
@@ -1667,7 +1677,8 @@
 	       (case s of
 		  W8 => pmd (x86.Instruction.MUL, x86.Instruction.C)
 		| W16 => pmd (x86.Instruction.MUL, x86.Instruction.C)
-		| W32 => pmd (x86.Instruction.MUL, x86.Instruction.C))
+		| W32 => pmd (x86.Instruction.MUL, x86.Instruction.C)
+		| W64 => Error.bug "FIXME")
 	   | _ => Error.bug ("arith: strange Prim.Name.t: " ^ primName))]
       end
 



1.49      +21 -6     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.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- x86-translate.fun	7 Aug 2003 00:50:51 -0000	1.48
+++ x86-translate.fun	10 Sep 2003 01:00:11 -0000	1.49
@@ -354,13 +354,26 @@
 	       end
 	  | Word w =>
 	       let
-		  val w' = WordX.toWord w
-		  val w'' = x86.Operand.immediate_const_word w'
+		  fun single size =
+		     Vector.new1
+		     (x86.Operand.immediate_const_word
+		      (Word.fromLarge (WordX.toLargeWord w)),
+		      size)
 	       in
 		  case WordX.size w of
-		     W8 => Vector.new1 (w'', x86.Size.BYTE)
-		   | W16 => Vector.new1 (w'', x86.Size.WORD)
-		   | W32 => Vector.new1 (w'', x86.Size.LONG)
+		     W8 => single x86.Size.BYTE
+		   | W16 => single x86.Size.WORD
+		   | W32 => single x86.Size.LONG
+		   | W64 =>
+			let
+			   val w = WordX.toLargeWord w
+			   val lo = Word.fromLarge w
+			   val hi = Word.fromLarge (LargeWord.>> (w, 0w32))
+			in
+			   Vector.new2
+			   ((x86.Operand.immediate_const_word lo, x86.Size.LONG),
+			    (x86.Operand.immediate_const_word hi, x86.Size.LONG))
+			end
 	       end
 	       
       val toX86Operand =
@@ -902,7 +915,9 @@
 		     | Word {cases, default, size, test} =>
 			  simple ({cases = (Vector.map
 					    (cases, fn (w, l) =>
-					     (WordX.toWord w, l))),
+					     (Word.fromLarge
+					      (WordX.toLargeWord w),
+					      l))),
 				   default = default,
 				   test = test},
 				  doSwitchWord)



1.45      +6 -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.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- x86.fun	27 Aug 2003 21:13:32 -0000	1.44
+++ x86.fun	10 Sep 2003 01:00:11 -0000	1.45
@@ -161,6 +161,7 @@
 		       W8 => Vector.new1 BYTE
 		     | W16 => Vector.new1 WORD 
 		     | W32 => Vector.new1 LONG
+		     | W64 => Vector.new2 (LONG, LONG)
 		  end
       end
 
@@ -739,6 +740,7 @@
 		       W8 => One
 		     | W16 => Two
 		     | W32 => Four
+		     | W64 => Eight
 		  end
       end
 
@@ -1497,6 +1499,10 @@
 				       dst = cReturnTempContent (0, WORD)}]
 			    | W32 => [{src = register Register.eax,
 				       dst = cReturnTempContent (0, LONG)}]
+			    | W64 => [{src = register Register.eax,
+				       dst = cReturnTempContent (0, LONG)},
+				      {src = register Register.edx,
+				       dst = cReturnTempContent (4, LONG)}]
 			 end
       end
     end



1.24      +3 -1      mlton/mlton/ssa/type-check.fun

Index: type-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/type-check.fun,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- type-check.fun	23 Jun 2003 04:58:59 -0000	1.23
+++ type-check.fun	10 Sep 2003 01:00:12 -0000	1.24
@@ -124,7 +124,9 @@
 		  case cases of
 		     Cases.Con cs => doitCon cs 
 		   | Cases.Int (_, cs) => doit (cs, IntX.equals, IntX.hash)
-		   | Cases.Word (_, cs) => doit (cs, WordX.equals, WordX.toWord)
+		   | Cases.Word (_, cs) =>
+			doit (cs, WordX.equals,
+			      LargeWord.toWord o WordX.toLargeWord)
 	       end
 	  | Goto {args, ...} => getVars args
 	  | Raise xs => getVars xs



1.27      +2 -3      mlton/mlton/type-inference/infer.fun

Index: infer.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/type-inference/infer.fun,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- infer.fun	21 Jul 2003 21:53:50 -0000	1.26
+++ infer.fun	10 Sep 2003 01:00:12 -0000	1.27
@@ -189,8 +189,7 @@
    in
       case Aconst.node c of
 	 Aconst.Char c =>
-	    Xconst.Word (WordX.make (Word8.toWord (Word8.fromChar c),
-				     WordSize.W8))
+	    Xconst.Word (WordX.make (LargeWord.fromChar c, WordSize.W8))
        | Aconst.Int i =>
 	    if Xtype.equals (ty, Xtype.intInf)
 	       then Xconst.IntInf i
@@ -208,7 +207,7 @@
        | Aconst.Word w =>
 	    choose (WordSize.all, Xtype.word, "word", fn s =>
 		    Xconst.Word
-		    (if IntInf.<= (w, Word.toIntInf (WordSize.max s))
+		    (if IntInf.<= (w, LargeWord.toIntInf (WordSize.max s))
 			then WordX.fromLargeInt (w, s)
 		     else (error (concat [Xtype.toString ty, " too big"])
 			   ; WordX.zero s)))



1.6       +3 -4      mlton/mlton/type-inference/match-compile.fun

Index: match-compile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/type-inference/match-compile.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- match-compile.fun	7 Aug 2003 00:50:51 -0000	1.5
+++ match-compile.fun	10 Sep 2003 01:00:12 -0000	1.6
@@ -154,13 +154,12 @@
 		       (get const, finish (Vector.fromList infos))))))
 in
    val directCases = 
-      make (if !Control.Native.native
-	      then List.remove(IntSize.all, fn s => IntSize.I64 = s)
-	      else IntSize.all,
+      make (List.remove (IntSize.all, fn s => IntSize.I64 = s),
 	    Type.int, Cases.int,
 	    fn Const.Int i => i
 	     | _ => Error.bug "caseInt type error")
-      @ make (WordSize.all, Type.word, Cases.word,
+      @ make (List.remove (WordSize.all, fn s => WordSize.W64 = s),
+	      Type.word, Cases.word,
 	      fn Const.Word w => w
 	       | _ => Error.bug "caseWord type error")
 end




-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel