1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
(* Copyright (C) 2013 Matthew Fluet.
* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
* MLton is released under a HPND-style license.
* See the file MLton-LICENSE for details.
*)
functor Word (W: PRIM_WORD) : WORD_EXTRA =
struct
open W
type t = word
val wordSize: Int.int = Primitive.Int32.zextdToInt sizeInBits
val sizeInBitsWord = Primitive.Word32.zextdToWord sizeInBitsWord
fun << (i, n) =
if Word.>= (n, sizeInBitsWord)
then zero
else W.<<? (i, Primitive.Word32.zextdFromWord n)
fun >> (i, n) =
if Word.>= (n, sizeInBitsWord)
then zero
else W.>>? (i, Primitive.Word32.zextdFromWord n)
fun ~>> (i, n) =
if Word.< (n, sizeInBitsWord)
then W.~>>? (i, Primitive.Word32.zextdFromWord n)
else W.~>>? (i, Primitive.Word32.- (W.sizeInBitsWord, 0w1))
fun rol (i, n) = W.rolUnsafe (i, Primitive.Word32.zextdFromWord n)
fun ror (i, n) = W.rorUnsafe (i, Primitive.Word32.zextdFromWord n)
local
fun st (w, msk, sft) =
let
val odd = andb (w, msk)
val evn = xorb (w, odd)
in
(xorb (W.<<? (odd, sft), W.>>? (evn, sft)),
xorb (msk, W.<<? (msk, Primitive.Word32.>>? (sft, 0w1))),
Primitive.Word32.>>? (sft, 0w1))
end
val (f, sft : Primitive.Word32.t) =
case W.sizeInBitsWord of
0w8 => (fn x => x, 0w4)
| 0w16 => (st, 0w8)
| 0w32 => (st o st, 0w16)
| 0w64 => (st o st o st, 0w32)
| _ => raise (Fail "Word.bswap")
in
fun bswap w = #1 (f (w, W.<<? (one, sft) - one, sft))
end
val fromInt = W.sextdFromInt
val toIntX = W.schckToInt
fun toInt w =
let
val i = W.zchckToInt w
in
if Primitive.Controls.detectOverflow
andalso (case Int.precision of
NONE => false
| SOME precision =>
Int32.<= (precision, W.sizeInBits))
andalso Int.< (i, 0)
then raise Overflow
else i
end
val fromLargeInt = W.sextdFromLargeInt
val toLargeIntX = W.schckToLargeInt
fun toLargeInt w =
let
val i = W.zchckToLargeInt w
in
if Primitive.Controls.detectOverflow
andalso (case LargeInt.precision of
NONE => false
| SOME precision =>
Int32.<= (precision, W.sizeInBits))
andalso LargeInt.< (i, 0)
then raise Overflow
else i
end
val fromLargeWord = W.zextdFromLargeWord
val fromLarge = fromLargeWord
val toLargeWordX = W.sextdToLargeWord
val toLargeX = toLargeWordX
val toLargeWord = W.zextdToLargeWord
val toLarge = toLargeWord
val fromWord = W.zextdFromWord
val toWordX = W.sextdToWord
val toWord = W.zextdToWord
local
(* Allocate a buffer large enough to hold any formatted word in any radix.
* The most that will be required is for maxWord in binary.
*)
val maxNumDigits = wordSize
val oneBuf = One.make (fn () => CharArray.array (maxNumDigits, #"\000"))
in
fun fmt radix (w: word): string =
One.use
(oneBuf, fn buf =>
let
val radix = fromInt (StringCvt.radixToInt radix)
fun loop (q, i: Int.int) =
let
val _ =
CharArray.update
(buf, i, StringCvt.digitToChar (toInt (q mod radix)))
val q = q div radix
in
if q = zero
then CharArraySlice.vector
(CharArraySlice.slice (buf, i, NONE))
else loop (q, Int.- (i, 1))
end
in
loop (w, Int.- (maxNumDigits, 1))
end)
end
(*
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 String.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)
|
