[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