[MLton-devel] cvs commit: Word64 is there
Stephen Weeks
sweeks@users.sourceforge.net
Wed, 10 Sep 2003 17:51:08 -0700
sweeks 03/09/10 17:51:08
Modified: basis-library/arrays-and-vectors mono.sml
basis-library/integer patch.sml
basis-library/libs build
basis-library/libs/basis-2002/top-level basis.sig basis.sml
overloads.sml
basis-library/misc primitive.sml
bin check-basis
doc changelog
doc/user-guide basis.tex
include c-chunk.h
mlton/ast prim-tycons.fun
mlton/backend ssa-to-rssa.fun
runtime Makefile
Added: basis-library/integer word.sml
regression word-all.ok word-all.sml
runtime/basis/Int Word64.c
Removed: basis-library/integer word.fun word16.sml word32.sml
word8.sml
regression word.sub.ok word.sub.sml word2.ok word2.sml
word8.ok word8.sml
Log:
Word64 is implemented, much as Int64 is, with _import for all the
primitives. This is especially bad for coercions that bounce through
LargeWord (which is now Word64), since they will involve a couple of C
calls and cannot be simplified away.
Hopefully the Word64 primitives can be added to the x86 codegen at the
same time as the Int64 ones. As the primitives are added, they should
be propagated to basis-library/misc/primitive.sml, eliminated from
runtime/basis/Int/Word64.c, and uncommented in include/c-chunk.h.
Added a new regression, word-all.sml, that tests all of the functions
in all of the Word modules.
Revision Changes Path
1.3 +15 -5 mlton/basis-library/arrays-and-vectors/mono.sml
Index: mono.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mono.sml 5 Sep 2003 23:01:00 -0000 1.2
+++ mono.sml 11 Sep 2003 00:51:06 -0000 1.3
@@ -148,6 +148,16 @@
structure Word32ArraySlice = ArraySlice
structure Word32Array2 = Array2
end
+local
+ structure S = EqMono (type elem = Word64.word)
+ open S
+in
+ structure Word64Vector = Vector
+ structure Word64VectorSlice = VectorSlice
+ structure Word64Array = Array
+ structure Word64ArraySlice = ArraySlice
+ structure Word64Array2 = Array2
+end
structure IntVector = Int32Vector
structure IntVectorSlice = Int32VectorSlice
@@ -179,8 +189,8 @@
structure WordArraySlice = Word32ArraySlice
structure WordArray2 = Word32Array2
-structure LargeWordVector = Word32Vector
-structure LargeWordVectorSlice = Word32VectorSlice
-structure LargeWordArray = Word32Array
-structure LargeWordArraySlice = Word32ArraySlice
-structure LargeWordArray2 = Word32Array2
+structure LargeWordVector = Word64Vector
+structure LargeWordVectorSlice = Word64VectorSlice
+structure LargeWordArray = Word64Array
+structure LargeWordArraySlice = Word64ArraySlice
+structure LargeWordArray2 = Word64Array2
1.9 +29 -1 mlton/basis-library/integer/patch.sml
Index: patch.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/patch.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- patch.sml 5 Sep 2003 23:01:01 -0000 1.8
+++ patch.sml 11 Sep 2003 00:51:06 -0000 1.9
@@ -121,6 +121,34 @@
end
end
+structure Word64: WORD =
+ struct
+ open Word64
+
+ structure W = Word64
+
+ val t32 = IntInf.pow (2, 32)
+ val t64 = IntInf.pow (2, 64)
+
+ fun toLargeInt w =
+ IntInf.+ (Word32.toLargeInt (Word32.fromLarge w),
+ IntInf.<< (Word32.toLargeInt (Word32.fromLarge (>> (w, 0w32))),
+ 0w32))
+
+ fun toLargeIntX w =
+ if 0w0 = andb (w, << (0w1, 0w63))
+ then toLargeInt w
+ else IntInf.- (toLargeInt w, t64)
+
+ fun fromLargeInt (i: IntInf.int): word =
+ let
+ val (d, m) = IntInf.divMod (i, t32)
+ in
+ W.orb (W.<< (Word32.toLarge (Word32.fromLargeInt d), 0w32),
+ Word32.toLarge (Word32.fromLargeInt m))
+ end
+ end
+
structure Word = Word32
-structure LargeWord = Word32
+structure LargeWord = Word64
structure SysWord = Word32
1.1 mlton/basis-library/integer/word.sml
Index: word.sml
===================================================================
(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-1999 NEC Research Institute.
*
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
functor Word (W: PRE_WORD_EXTRA): WORD_EXTRA =
struct
open W
structure PW = Primitive.Word
val detectOverflow = Primitive.detectOverflow
(* These are overriden in patch.sml after int-inf.sml has been defined. *)
val toLargeInt: word -> LargeInt.int = fn _ => raise Fail "toLargeInt"
val toLargeIntX: word -> LargeInt.int = fn _ => raise Fail "toLargeIntX"
val fromLargeInt: LargeInt.int -> word = fn _ => raise Fail "fromLargeInt"
val wordSizeWord: Word.word = PW.fromInt wordSize
val wordSizeMinusOneWord: Word.word = PW.fromInt (Int.-? (wordSize, 1))
val zero: word = fromInt 0
val one: word = fromInt 1
val allOnes: word = notb zero
val toLargeWord = toLarge
val toLargeWordX = toLargeX
val fromLargeWord = fromLarge
fun toInt w =
if detectOverflow
andalso Int.>= (wordSize, Int.precision')
andalso w > fromInt Int.maxInt'
then raise Overflow
else W.toInt w
fun toIntX w =
if detectOverflow
andalso Int.> (wordSize, Int.precision')
andalso fromInt Int.maxInt' < w
andalso w < fromInt Int.minInt'
then raise Overflow
else W.toIntX w
local
fun make f (w, w') =
if Primitive.safe andalso w' = zero
then raise Div
else f (w, w')
in
val op div = make (op div)
val op mod = make (op mod)
end
fun << (i, n)
= if PW.>=(n ,wordSizeWord)
then zero
else W.<<(i, n)
fun >> (i, n)
= if PW.>=(n, wordSizeWord)
then zero
else W.>>(i, n)
fun ~>> (i, n)
= if PW.<(n, wordSizeWord)
then W.~>>(i, n)
else W.~>>(i, wordSizeMinusOneWord)
val {compare, min, max} = Util.makeCompare(op <)
fun fmt radix (w: word): string =
let val radix = fromInt (StringCvt.radixToInt radix)
fun loop (q, chars) =
let val chars = StringCvt.digitToChar (toInt (q mod radix)) :: chars
val q = q div radix
in if q = zero
then String0.implode chars
else loop (q, chars)
end
in loop (w, [])
end
val toString = fmt StringCvt.HEX
fun scan radix reader state =
let
val state = StringCvt.skipWS reader state
val charToDigit = StringCvt.charToDigit radix
val radixWord = fromInt (StringCvt.radixToInt radix)
fun finishNum (state, n) =
case reader state of
NONE => SOME (n, state)
| SOME (c, state') =>
case charToDigit c of
NONE => SOME (n, state)
| SOME n' =>
let val n'' = n * radixWord
in if n'' div radixWord = n
then let val n' = fromInt n'
val n''' = n'' + n'
in if n''' >= n''
then finishNum (state', n''')
else raise Overflow
end
else raise Overflow
end
fun num state = finishNum (state, zero)
in
case reader state of
NONE => NONE
| SOME (c, state) =>
case c of
#"0" =>
(case reader state of
NONE => SOME (zero, state)
| SOME (c, state') =>
case c of
#"w" => (case radix of
StringCvt.HEX =>
(case reader state' of
NONE =>
(* the #"w" was not followed by
* an #"X" or #"x", therefore we
* return 0 *)
SOME (zero, state)
| SOME (c, state) =>
(case c of
#"x" => num state
| #"X" => num state
| _ =>
(* the #"w" was not followed by
* an #"X" or #"x", therefore we
* return 0 *)
SOME (zero, state)))
| _ => num state')
| #"x" => (case radix of
StringCvt.HEX => num state'
| _ => NONE)
| #"X" => (case radix of
StringCvt.HEX => num state'
| _ => NONE)
| _ => num state)
| _ => (case charToDigit c of
NONE => NONE
| SOME n => finishNum (state, fromInt n))
end
val fromString = StringCvt.scanString (scan StringCvt.HEX)
end
structure Word8 = Word (Primitive.Word8)
structure Word16 = Word (Primitive.Word16)
structure Word32 = Word (Primitive.Word32)
structure Word64 = Word (Primitive.Word64)
structure Word = Word32
structure WordGlobal: WORD_GLOBAL = Word
open WordGlobal
1.23 +1 -4 mlton/basis-library/libs/build
Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- build 9 Sep 2003 14:48:57 -0000 1.22
+++ build 11 Sep 2003 00:51:06 -0000 1.23
@@ -59,10 +59,7 @@
misc/C.sig
misc/C.sml
integer/word.sig
-integer/word.fun
-integer/word8.sml
-integer/word16.sml
-integer/word32.sml
+integer/word.sml
integer/int-inf.sig
integer/int-inf.sml
real/IEEE-real.sig
1.19 +11 -5 mlton/basis-library/libs/basis-2002/top-level/basis.sig
Index: basis.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sig,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- basis.sig 9 Sep 2003 23:38:22 -0000 1.18
+++ basis.sig 11 Sep 2003 00:51:06 -0000 1.19
@@ -231,6 +231,11 @@
(*
structure Windows : WINDOWS
*)
+ structure WordArray : MONO_ARRAY
+ structure WordArray2 : MONO_ARRAY2
+ structure WordArraySlice : MONO_ARRAY_SLICE
+ structure WordVector : MONO_VECTOR
+ structure WordVectorSlice : MONO_VECTOR_SLICE
structure Word16 : WORD
structure Word16Array : MONO_ARRAY
structure Word16Array2 : MONO_ARRAY2
@@ -243,11 +248,12 @@
structure Word32ArraySlice : MONO_ARRAY_SLICE
structure Word32Vector : MONO_VECTOR
structure Word32VectorSlice : MONO_VECTOR_SLICE
- structure WordArray : MONO_ARRAY
- structure WordArray2 : MONO_ARRAY2
- structure WordArraySlice : MONO_ARRAY_SLICE
- structure WordVector : MONO_VECTOR
- structure WordVectorSlice : MONO_VECTOR_SLICE
+ structure Word64 : WORD
+ structure Word64Array : MONO_ARRAY
+ structure Word64Array2 : MONO_ARRAY2
+ structure Word64ArraySlice : MONO_ARRAY_SLICE
+ structure Word64Vector : MONO_VECTOR
+ structure Word64VectorSlice : MONO_VECTOR_SLICE
(* ************************************************** *)
(* ************************************************** *)
1.17 +11 -5 mlton/basis-library/libs/basis-2002/top-level/basis.sml
Index: basis.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sml,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- basis.sml 9 Sep 2003 23:38:22 -0000 1.16
+++ basis.sml 11 Sep 2003 00:51:06 -0000 1.17
@@ -150,6 +150,11 @@
(*
structure Windows = Windows
*)
+ structure WordArray = WordArray
+ structure WordArray2 = WordArray2
+ structure WordArraySlice = WordArraySlice
+ structure WordVector = WordVector
+ structure WordVectorSlice = WordVectorSlice
structure Word16 = Word16
structure Word16Array = Word16Array
structure Word16Array2 = Word16Array2
@@ -162,11 +167,12 @@
structure Word32ArraySlice = Word32ArraySlice
structure Word32Vector = Word32Vector
structure Word32VectorSlice = Word32VectorSlice
- structure WordArray = WordArray
- structure WordArray2 = WordArray2
- structure WordArraySlice = WordArraySlice
- structure WordVector = WordVector
- structure WordVectorSlice = WordVectorSlice
+ structure Word64 = Word64
+ structure Word64Array = Word64Array
+ structure Word64Array2 = Word64Array2
+ structure Word64ArraySlice = Word64ArraySlice
+ structure Word64Vector = Word64Vector
+ structure Word64VectorSlice = Word64VectorSlice
open ArrayGlobal
BoolGlobal
1.7 +14 -1 mlton/basis-library/libs/basis-2002/top-level/overloads.sml
Index: overloads.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/overloads.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- overloads.sml 6 Sep 2003 18:41:26 -0000 1.6
+++ overloads.sml 11 Sep 2003 00:51:06 -0000 1.7
@@ -9,7 +9,7 @@
(*
* * int = {Int.int, Int8.int, Int16.int, Int32.int, Int64.int,
* IntInf.int, LargeInt.int, FixedInt.int, Position.int}
- * * word = {Word.word, Word8.word, Word16.word, Word32.word,
+ * * word = {Word.word, Word8.word, Word16.word, Word32.word, Word64.word,
* LargeWord.word, SysWord.word}
* * real = {Real.real, Real32.real, Real.64.real,
* LargeReal.real}
@@ -34,6 +34,7 @@
* and Word8.f
* and Word16.f
* and Word32.f
+ * and Word64.f
* and LargeWord.f
* and SysWord.f
* and Real.f
@@ -56,6 +57,7 @@
* and Word8.f
* and Word16.f
* and Word32.f
+ * and Word64.f
* and LargeWord.f
* and SysWord.f
*
@@ -90,6 +92,7 @@
* and Word8.f
* and Word16.f
* and Word32.f
+ * and Word64.f
* and LargeWord.f
* and SysWord.f
* and Real.f
@@ -114,6 +117,7 @@
and Word8.~
and Word16.~
and Word32.~
+and Word64.~
and LargeWord.~
and SysWord.~
and Real.~
@@ -135,6 +139,7 @@
and Word8.+
and Word16.+
and Word32.+
+and Word64.+
and LargeWord.+
and SysWord.+
and Real.+
@@ -156,6 +161,7 @@
and Word8.-
and Word16.-
and Word32.-
+and Word64.-
and LargeWord.-
and SysWord.-
and Real.-
@@ -177,6 +183,7 @@
and Word8.*
and Word16.*
and Word32.*
+and Word64.*
and LargeWord.*
and SysWord.*
and Real.*
@@ -213,6 +220,7 @@
and Word8.div
and Word16.div
and Word32.div
+and Word64.div
and LargeWord.div
and SysWord.div
@@ -230,6 +238,7 @@
and Word8.mod
and Word16.mod
and Word32.mod
+and Word64.mod
and LargeWord.mod
and SysWord.mod
@@ -262,6 +271,7 @@
and Word8.<
and Word16.<
and Word32.<
+and Word64.<
and LargeWord.<
and SysWord.<
and Real.<
@@ -285,6 +295,7 @@
and Word8.<=
and Word16.<=
and Word32.<=
+and Word64.<=
and LargeWord.<=
and SysWord.<=
and Real.<=
@@ -308,6 +319,7 @@
and Word8.>
and Word16.>
and Word32.>
+and Word64.>
and LargeWord.>
and SysWord.>
and Real.>
@@ -331,6 +343,7 @@
and Word8.>=
and Word16.>=
and Word32.>=
+and Word64.>=
and LargeWord.>=
and SysWord.>=
and Real.>=
1.78 +71 -24 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- primitive.sml 5 Sep 2003 23:01:03 -0000 1.77
+++ primitive.sml 11 Sep 2003 00:51:06 -0000 1.78
@@ -37,6 +37,7 @@
struct
type int = int32
end
+structure Int = Int32
structure Int64 =
struct
type int = int64
@@ -45,8 +46,10 @@
struct
type int = intInf
end
+structure LargeInt = IntInf
datatype list = datatype list
type pointer = pointer (* C integer, not SML heap pointer *)
+
structure Real32 =
struct
type real = real32
@@ -55,9 +58,12 @@
struct
type real = real64
end
+structure Real = Real64
+
datatype ref = datatype ref
type preThread = preThread
type thread = thread
+
structure Word8 =
struct
type word = word8
@@ -70,16 +76,20 @@
struct
type word = word32
end
+structure Word = Word32
+structure Word64 =
+ struct
+ type word = word64
+ end
+structure LargeWord = Word64
+
type 'a vector = 'a vector
type 'a weak = 'a weak
type string = char vector
type nullString = string
-structure Int = Int32
type int = Int.int
-structure Real = Real64
type real = Real.real
-structure Word = Word32
type word = Word.word
exception Bind = Bind
@@ -1155,20 +1165,21 @@
structure Word8 =
struct
- type word = word8
+ open Word8
+
val wordSize: int = 8
val + = _prim "Word8_add": word * word -> word;
val addCheck = _prim "Word8_addCheck": word * word -> word;
val andb = _prim "Word8_andb": word * word -> word;
- val ~>> = _prim "Word8_arshift": word * word32 -> word;
+ val ~>> = _prim "Word8_arshift": word * Word.word -> word;
val div = _prim "Word8_div": word * word -> word;
val fromInt = _prim "Int32_toWord8": int -> word;
- val fromLarge = _prim "Word32_toWord8": word32 -> word;
+ val fromLarge = _import "Word64_toWord8": LargeWord.word -> word;
val >= = _prim "Word8_ge": word * word -> bool;
val > = _prim "Word8_gt" : word * word -> bool;
val <= = _prim "Word8_le": word * word -> bool;
- val << = _prim "Word8_lshift": word * word32 -> word;
+ val << = _prim "Word8_lshift": word * Word.word -> word;
val < = _prim "Word8_lt" : word * word -> bool;
val mod = _prim "Word8_mod": word * word -> word;
val * = _prim "Word8_mul": word * word -> word;
@@ -1176,15 +1187,15 @@
val ~ = _prim "Word8_neg": word -> word;
val notb = _prim "Word8_notb": word -> word;
val orb = _prim "Word8_orb": word * word -> word;
- val rol = _prim "Word8_rol": word * word32 -> word;
- val ror = _prim "Word8_ror": word * word32 -> word;
- val >> = _prim "Word8_rshift": word * word32 -> word;
+ val rol = _prim "Word8_rol": word * Word.word -> word;
+ val ror = _prim "Word8_ror": word * Word.word -> word;
+ val >> = _prim "Word8_rshift": word * Word.word -> word;
val - = _prim "Word8_sub": word * word -> word;
val toChar = _prim "Word8_toChar": word -> char;
val toInt = _prim "Word8_toInt32": word -> int;
val toIntX = _prim "Word8_toInt32X": word -> int;
- val toLarge = _prim "Word8_toWord32": word -> word32;
- val toLargeX = _prim "Word8_toWord32X": word -> word32;
+ val toLarge = _import "Word8_toWord64": word -> LargeWord.word;
+ val toLargeX = _import "Word8_toWord64X": word -> LargeWord.word;
val xorb = _prim "Word8_xorb": word * word -> word;
end
@@ -1210,20 +1221,21 @@
structure Word16 =
struct
- type word = word16
+ open Word16
+
val wordSize: int = 16
val + = _prim "Word16_add": word * word -> word;
val addCheck = _prim "Word16_addCheck": word * word -> word;
val andb = _prim "Word16_andb": word * word -> word;
- val ~>> = _prim "Word16_arshift": word * word32 -> word;
+ val ~>> = _prim "Word16_arshift": word * Word.word -> word;
val div = _prim "Word16_div": word * word -> word;
val fromInt = _prim "Int32_toWord16": int -> word;
- val fromLarge = _prim "Word32_toWord16": word32 -> word;
+ val fromLarge = _import "Word64_toWord16": LargeWord.word -> word;
val >= = _prim "Word16_ge": word * word -> bool;
val > = _prim "Word16_gt" : word * word -> bool;
val <= = _prim "Word16_le": word * word -> bool;
- val << = _prim "Word16_lshift": word * word32 -> word;
+ val << = _prim "Word16_lshift": word * Word.word -> word;
val < = _prim "Word16_lt" : word * word -> bool;
val mod = _prim "Word16_mod": word * word -> word;
val * = _prim "Word16_mul": word * word -> word;
@@ -1231,14 +1243,14 @@
val ~ = _prim "Word16_neg": word -> word;
val notb = _prim "Word16_notb": word -> word;
val orb = _prim "Word16_orb": word * word -> word;
- val rol = _prim "Word16_rol": word * word32 -> word;
- val ror = _prim "Word16_ror": word * word32 -> word;
- val >> = _prim "Word16_rshift": word * word32 -> word;
+ val rol = _prim "Word16_rol": word * Word.word -> word;
+ val ror = _prim "Word16_ror": word * Word.word -> word;
+ val >> = _prim "Word16_rshift": word * Word.word -> word;
val - = _prim "Word16_sub": word * word -> word;
val toInt = _prim "Word16_toInt32": word -> int;
val toIntX = _prim "Word16_toInt32X": word -> int;
- val toLarge = _prim "Word16_toWord32": word -> word32;
- val toLargeX = _prim "Word16_toWord32X": word -> word32;
+ val toLarge = _import "Word16_toWord64": word -> LargeWord.word;
+ val toLargeX = _import "Word16_toWord64X": word -> LargeWord.word;
val xorb = _prim "Word16_xorb": word * word -> word;
end
@@ -1253,7 +1265,7 @@
val ~>> = _prim "Word32_arshift": word * word -> word;
val div = _prim "Word32_div": word * word -> word;
val fromInt = _prim "Int32_toWord32": int -> word;
- val fromLarge : word -> word = fn x => x
+ val fromLarge = _import "Word64_toWord32": LargeWord.word -> word;
val >= = _prim "Word32_ge": word * word -> bool;
val > = _prim "Word32_gt" : word * word -> bool;
val <= = _prim "Word32_le": word * word -> bool;
@@ -1271,12 +1283,47 @@
val - = _prim "Word32_sub": word * word -> word;
val toInt = _prim "Word32_toInt32": word -> int;
val toIntX = _prim "Word32_toInt32X": word -> int;
- val toLarge : word -> word = fn x => x
- val toLargeX : word -> word = fn x => x
+ val toLarge = _import "Word32_toWord64": word -> LargeWord.word;
+ val toLargeX = _import "Word32_toWord64X": word -> LargeWord.word;
val xorb = _prim "Word32_xorb": word * word -> word;
end
structure Word = Word32
+ structure Word64 =
+ struct
+ open Word64
+
+ val wordSize: int = 64
+ val + = _import "Word64_add": word * word -> word;
+(* val addCheck = _import "Word64_addCheck": word * word -> word; *)
+ val andb = _import "Word64_andb": word * word -> word;
+ val ~>> = _import "Word64_arshift": word * Word.word -> word;
+ val div = _import "Word64_div": word * word -> word;
+ val fromInt = _import "Int32_toWord64": int -> word;
+ val fromLarge: LargeWord.word -> word = fn x => x
+ val >= = _import "Word64_ge": word * word -> bool;
+ val > = _import "Word64_gt" : word * word -> bool;
+ val <= = _import "Word64_le": word * word -> bool;
+ val << = _import "Word64_lshift": word * Word.word -> word;
+ val < = _import "Word64_lt" : word * word -> bool;
+ val mod = _import "Word64_mod": word * word -> word;
+ val * = _import "Word64_mul": word * word -> word;
+(* val mulCheck = _import "Word64_mulCheck": word * word -> word; *)
+ val ~ = _import "Word64_neg": word -> word;
+ val notb = _import "Word64_notb": word -> word;
+ val orb = _import "Word64_orb": word * word -> word;
+ val rol = _import "Word64_rol": word * Word.word -> word;
+ val ror = _import "Word64_ror": word * Word.word -> word;
+ val >> = _import "Word64_rshift": word * Word.word -> word;
+ val - = _import "Word64_sub": word * word -> word;
+ val toInt = _import "Word64_toInt32": word -> int;
+ val toIntX = _import "Word64_toInt32X": word -> int;
+ val toLarge: word -> LargeWord.word = fn x => x
+ val toLargeX: word -> LargeWord.word = fn x => x
+ val xorb = _import "Word64_xorb": word * word -> word;
+ end
+ structure LargeWord = Word64
+
structure World =
struct
val isOriginal = _import "World_isOriginal": unit -> bool;
1.18 +1 -0 mlton/bin/check-basis
Index: check-basis
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/check-basis,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- check-basis 19 Jul 2003 01:23:25 -0000 1.17
+++ check-basis 11 Sep 2003 00:51:07 -0000 1.18
@@ -130,6 +130,7 @@
type word8 = Word8.word
type word16 = Word32.word
type word32 = Word32.word
+ type word64 = Word32.word
type 'a vector = 'a vector
datatype 'a option = T
1.75 +3 -0 mlton/doc/changelog
Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -r1.74 -r1.75
--- changelog 10 Sep 2003 00:16:02 -0000 1.74
+++ changelog 11 Sep 2003 00:51:07 -0000 1.75
@@ -1,5 +1,8 @@
Here are the changes since version 20030716.
+* 2003-09-10
+ - Word64 is now there.
+
* 2003-09-09
- Replaced Pack32{Big,Little} with PackWord32{Big,Little}.
- Fixed bug in OS.FileSys.fullPath, which mistakenly stopped as soon
1.31 +6 -0 mlton/doc/user-guide/basis.tex
Index: basis.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/basis.tex,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- basis.tex 9 Sep 2003 23:38:22 -0000 1.30
+++ basis.tex 11 Sep 2003 00:51:07 -0000 1.31
@@ -328,6 +328,12 @@
\fullmodule{Word32ArraySlice}{MONO\_ARRAY\_SLICE}
\fullmodule{Word32Vector}{MONO\_VECTOR}
\fullmodule{Word32VectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{Word64}{WORD}
+\fullmodule{Word64Array}{MONO\_ARRAY}
+\fullmodule{Word64Array2}{MONO\_ARRAY2}
+\fullmodule{Word64ArraySlice}{MONO\_ARRAY\_SLICE}
+\fullmodule{Word64Vector}{MONO\_VECTOR}
+\fullmodule{Word64VectorSlice}{MONO\_VECTOR\_SLICE}
The following structures equivalences hold.\\
\begin{tabular}{l}
1.14 +7 -7 mlton/include/c-chunk.h
Index: c-chunk.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-chunk.h,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- c-chunk.h 5 Sep 2003 18:47:33 -0000 1.13
+++ c-chunk.h 11 Sep 2003 00:51:07 -0000 1.14
@@ -239,7 +239,7 @@
#define Word8_max (Word8)0xFF
#define Word16_max (Word16)0xFFFF
#define Word32_max (Word32)0xFFFFFFFF
-#define Word64_max (Word64)0xFFFFFFFFFFFFFFFF
+//#define Word64_max (Word64)0xFFFFFFFFFFFFFFFF
#define Int_addCheckXC(size, dst, x, c, l) \
do { \
@@ -319,16 +319,16 @@
#define Word8_addCheckXC(dst, x, c, l) Word_addCheckXC(8, dst, x, c, l)
#define Word16_addCheckXC(dst, x, c, l) Word_addCheckXC(16, dst, x, c, l)
#define Word32_addCheckXC(dst, x, c, l) Word_addCheckXC(32, dst, x, c, l)
-#define Word64_addCheckXC(dst, x, c, l) Word_addCheckXC(64, dst, x, c, l)
+//#define Word64_addCheckXC(dst, x, c, l) Word_addCheckXC(64, dst, x, c, l)
#define Word8_addCheckCX(dst, c, x, l) Word_addCheckXC(8, dst, x, c, l)
#define Word16_addCheckCX(dst, c, x, l) Word_addCheckXC(16, dst, x, c, l)
#define Word32_addCheckCX(dst, c, x, l) Word_addCheckXC(32, dst, x, c, l)
-#define Word64_addCheckCX(dst, c, x, l) Word_addCheckXC(64, dst, x, c, l)
+//#define Word64_addCheckCX(dst, c, x, l) Word_addCheckXC(64, dst, x, c, l)
#define Word8_addCheck Word8_addCheckXC
#define Word16_addCheck Word16_addCheckXC
#define Word32_addCheck Word32_addCheckXC
-#define Word64_addCheck Word64_addCheckXC
+//#define Word64_addCheck Word64_addCheckXC
#define mulOverflow(kind, small, large) \
static inline kind##small kind##small##_##mulOverflow \
@@ -379,8 +379,8 @@
check (dst, n1, n2, l, Word16_mulOverflow)
#define Word32_mulCheck(dst, n1, n2, l) \
check (dst, n1, n2, l, Word32_mulOverflow)
-#define Word64_mulCheck(dst, n1, n2, l) \
- fprintf (stderr, "FIXME: Word64_mulCheck\n");
+//#define Word64_mulCheck(dst, n1, n2, l) \
+// fprintf (stderr, "FIXME: Word64_mulCheck\n");
#endif /* INT_TEST */
@@ -595,7 +595,7 @@
wordOps(8)
wordOps(16)
wordOps(32)
-wordOps(64)
+//wordOps(64)
#undef wordBinary wordCmp wordShift wordUnary
#define coerce(f, t) \
1.8 +2 -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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- prim-tycons.fun 10 Sep 2003 01:00:08 -0000 1.7
+++ prim-tycons.fun 11 Sep 2003 00:51:07 -0000 1.8
@@ -88,9 +88,9 @@
local
fun is l t = List.exists (l, fn t' => equals (t, t'))
in
- val isIntX = is [int8, int16, int32, int64, int8, intInf]
+ val isIntX = is [int8, int16, int32, int64, intInf]
val isRealX = is [real32, real64]
- val isWordX = is [word8, word16, word32]
+ val isWordX = is [word8, word16, word32, word64]
end
end
1.48 +9 -0 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.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- ssa-to-rssa.fun 10 Sep 2003 01:00:10 -0000 1.47
+++ ssa-to-rssa.fun 11 Sep 2003 00:51:07 -0000 1.48
@@ -36,6 +36,7 @@
val Int32 = Int I32
val Int64 = Int I64
val Word32 = Word W32
+ val Word64 = Word W64
end
datatype z = datatype CType.t
@@ -128,6 +129,10 @@
val int64Equal = make "Int64_equal"
end
+ val word64Equal = vanilla {args = Vector.new2 (Word64, Word64),
+ name = "Word64_equal",
+ return = SOME CType.defaultInt}
+
val getPointer =
vanilla {args = Vector.new1 Int32,
name = "MLton_FFI_getPointer",
@@ -1365,6 +1370,10 @@
func = CFunction.weakNew}
end,
none)
+ | Word_equal s =>
+ if s = WordSize.W64
+ then simpleCCall CFunction.word64Equal
+ else normal ()
| Word_toIntInf => cast ()
| WordVector_toIntInf => cast ()
| Word8Array_subWord => sub Type.defaultWord
1.1 mlton/regression/word-all.ok
Index: word-all.ok
===================================================================
Testing Word8
FF
11111111
377
255
FF
FE
11111110
376
254
FE
7F
1111111
177
127
7F
F
1111
17
15
F
2
10
2
2
2
1
1
1
1
1
0
0
0
0
0
Testing Word16
FFFF
1111111111111111
177777
65535
FFFF
FFFE
1111111111111110
177776
65534
FFFE
7FFF
111111111111111
77777
32767
7FFF
F
1111
17
15
F
2
10
2
2
2
1
1
1
1
1
0
0
0
0
0
Testing Word32
FFFFFFFF
11111111111111111111111111111111
37777777777
4294967295
FFFFFFFF
FFFFFFFE
11111111111111111111111111111110
37777777776
4294967294
FFFFFFFE
7FFFFFFF
1111111111111111111111111111111
17777777777
2147483647
7FFFFFFF
F
1111
17
15
F
2
10
2
2
2
1
1
1
1
1
0
0
0
0
0
Testing Word64
FFFFFFFFFFFFFFFF
1111111111111111111111111111111111111111111111111111111111111111
1777777777777777777777
18446744073709551615
FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFE
1111111111111111111111111111111111111111111111111111111111111110
1777777777777777777776
18446744073709551614
FFFFFFFFFFFFFFFE
7FFFFFFFFFFFFFFF
111111111111111111111111111111111111111111111111111111111111111
777777777777777777777
9223372036854775807
7FFFFFFFFFFFFFFF
F
1111
17
15
F
2
10
2
2
2
1
1
1
1
1
0
0
0
0
0
1.1 mlton/regression/word-all.sml
Index: word-all.sml
===================================================================
functor Test (W: WORD) =
struct
structure LW = LargeWord
val zero = W.fromInt 0
val one = W.fromInt 1
val two = W.fromInt 2
val max = W.~ one
val words =
[max,
W.- (max, one),
W.div (max, two),
W.fromInt 0xF,
two,
one,
zero]
fun foreach (l, f) = List.app f l
fun for (f: W.word -> unit) = foreach (words, f)
structure Answer =
struct
datatype t =
Div
| Overflow
| Word of W.word
val toString =
fn Div => "Div"
| Overflow => "Overflow"
| Word w => W.toString w
fun run (f: unit -> W.word): t =
Word (f ())
handle General.Div => Div
| General.Overflow => Overflow
val equals: t * t -> bool = op =
end
val m = concat ["Word", Int.toString W.wordSize]
val _ = print (concat ["Testing ", m, "\n"])
fun err msg = print (concat [m, ": ", concat msg, "\n"])
val _ = for (fn w =>
print (concat [W.toString w, "\n",
"\t", W.fmt StringCvt.BIN w, "\n",
"\t", W.fmt StringCvt.OCT w, "\n",
"\t", W.fmt StringCvt.DEC w, "\n",
"\t", W.fmt StringCvt.HEX w, "\n"]))
val _ =
foreach
([("+", W.+, LW.+),
("-", W.-, LW.-),
("*", W.*, LW.* ),
("andb", W.andb, LW.andb),
("div", W.div, LW.div),
("max", W.max, LW.max),
("min", W.min, LW.min),
("mod", W.mod, LW.mod),
("orb", W.orb, LW.orb),
("xorb", W.xorb, LW.xorb)],
fn (name, f, f') =>
for
(fn w =>
for
(fn w' =>
let
val a = Answer.run (fn () => f (w, w'))
val a' = Answer.run (fn () =>
W.fromLarge (f' (W.toLarge w, W.toLarge w')))
in
if Answer.equals (a, a')
then ()
else err [W.toString w, " ", name, " ", W.toString w',
" = ", Answer.toString a, " <> ", Answer.toString a']
end)))
val _ =
for (fn w =>
if w = valOf (W.fromString (W.toString w))
then ()
else err ["{from,to}String"])
val _ =
foreach
([("<<", W.<<, LW.<<),
(">>", W.>>, LW.>>)],
fn (name, f, f') =>
for
(fn w =>
foreach
([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF],
fn w' =>
let
val a = f (w, w')
val a' = W.fromLarge (f' (W.toLarge w, w'))
in
if a = a'
then ()
else err [W.toString w, " ", name, " ", Word.toString w',
" = ", W.toString a, " <> ", W.toString a']
end)))
val _ =
foreach
([("~>>", W.~>>, LW.~>>)],
fn (name, f, f') =>
for
(fn w =>
foreach
([0w0, 0w1, 0w2, 0w4, 0w8, 0w15, 0w30, 0wxFF],
fn w' =>
let
val a = f (w, w')
val a' = W.fromLarge (f' (W.toLargeX w, w'))
in
if a = a'
then ()
else err [W.toString w, " ", name, " ", Word.toString w',
" = ", W.toString a, " <> ", W.toString a']
end)))
val _ =
foreach
([("<", W.<, LW.<),
("<=", W.<=, LW.<=),
(">", W.>, LW.>),
(">=", W.>=, LW.>=)],
fn (name, f, f') =>
for
(fn w =>
for
(fn w' =>
let
val b = f (w, w')
val b' = f' (W.toLarge w, W.toLarge w')
in
if b = b'
then ()
else err [W.toString w, " ", name, " ", W.toString w',
" = ", Bool.toString b, " <> ", Bool.toString b']
end)))
val _ =
foreach
([("compare", W.compare, LW.compare)],
fn (name, f, f') =>
for
(fn w =>
for
(fn w' =>
let
val or = f (w, w')
val or' = f' (W.toLarge w, W.toLarge w')
in
if or = or'
then ()
else err [W.toString w, " ", name, " ", W.toString w']
end)))
val _ =
for
(fn w =>
if w = W.fromLargeInt (W.toLargeInt w)
andalso w = W.fromLargeInt (W.toLargeIntX w)
andalso (case SOME (W.toInt w) handle Overflow => NONE of
NONE => true
| SOME i => w = W.fromInt i)
andalso (case SOME (W.toIntX w) handle Overflow => NONE of
NONE => true
| SOME i => w = W.fromInt i)
then ()
else err ["{from,to}Large"])
val _ =
for (fn w =>
let
val a = W.notb w
val a' = W.fromLarge (LW.notb (W.toLarge w))
in
if a = a'
then ()
else err ["notb ", W.toString w, " = ", W.toString a, " <> ",
W.toString a']
end)
val _ =
for (fn w =>
if W.~ w = W.- (0w0, w)
then ()
else err ["~"])
end
structure Z = Test (Word8)
structure Z = Test (Word16)
structure Z = Test (Word32)
structure Z = Test (Word64)
1.74 +2 -0 mlton/runtime/Makefile
Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -r1.73 -r1.74
--- Makefile 29 Aug 2003 00:25:21 -0000 1.73
+++ Makefile 11 Sep 2003 00:51:08 -0000 1.74
@@ -34,6 +34,7 @@
basis/Int/Int64.o \
basis/Int/Word8Array.o \
basis/Int/Word8Vector.o \
+ basis/Int/Word64.o \
basis/Int/addOverflow.o \
basis/Int/mulOverflow.o \
basis/Int/negOverflow.o \
@@ -201,6 +202,7 @@
basis/Int/Int64-gdb.o \
basis/Int/Word8Array-gdb.o \
basis/Int/Word8Vector-gdb.o \
+ basis/Int/Word64-gdb.o \
basis/Int/addOverflow-gdb.o \
basis/Int/mulOverflow-gdb.o \
basis/Int/negOverflow-gdb.o \
1.1 mlton/runtime/basis/Int/Word64.c
Index: Word64.c
===================================================================
#include "libmlton.h"
enum {
DEBUG = FALSE,
};
#define Word64_max (Word64)0x7FFFFFFFFFFFFFFF
#define Word64_min (Word64)0x8000000000000000
#define coerce(f, t) \
t f##_to##t (f x) { \
return (t)x; \
}
coerce(Int32,Word64)
coerce(Word8,Word64)
coerce(Word16,Word64)
coerce(Word32,Word64)
coerce(Word64,Int32)
coerce(Word64,Word8)
coerce(Word64,Word16)
coerce(Word64,Word32)
#undef coerce
#define coerceX(size, t) \
t Word##size##_to##t##X (Word##size w) { \
return (t)(Int##size)w; \
}
coerceX(8,Word64)
coerceX(16,Word64)
coerceX(32,Word64)
coerceX(64,Int32)
#undef coerceX
#define binary(name, op) \
Word64 Word64_##name (Word64 w1, Word64 w2) { \
return w1 op w2; \
}
binary (add, +)
binary (andb, &)
binary (div, /)
binary (mod, %)
binary (mul, *)
binary (orb, |)
binary (sub, -)
binary (xorb, ^)
#undef binary
#define unary(name, op) \
Word64 Word64_##name (Word64 w) { \
return op w; \
}
unary (neg, -)
unary (notb, ~)
#undef unary
#define compare(name, op) \
Bool Word64_##name (Word64 w1, Word64 w2) { \
return w1 op w2; \
}
compare (equal, ==)
compare (ge, >=)
compare (gt, >)
compare (le, <=)
compare (lt, <)
#undef binary
#define shift(name, op) \
Word64 Word64_##name (Word64 w1, Word w2) { \
return w1 op w2; \
}
shift (lshift, <<)
shift (rshift, >>)
#undef binary
Word64 Word64_arshift (Word64 w, Word s) {
return (Int64)w >> s;
}
Word64 Word64_rol (Word64 w1, Word w2) {
return (w1 >> (64 - w2)) | (w1 << w2);
}
Word64 Word64_ror (Word64 w1, Word w2) {
return (w1 >> w2) | (w1 << (64 - w2));
}
-------------------------------------------------------
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