Skip to content

Commit 5adfb61

Browse files
rossbergrossberg
committed
Merge pull request #27 from WebAssembly/unsigned
Implement unsigned operators
2 parents 01ed110 + 200d5d9 commit 5adfb61

File tree

5 files changed

+172
-63
lines changed

5 files changed

+172
-63
lines changed

‎ml-proto/runtests.py

+2-2
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ def find_interpreter(path):
5151
def rebuild_interpreter(path):
5252
print("// building %s" % path)
5353
sys.stdout.flush()
54-
exitCode = subprocess.call(["ocamlbuild", "-libs", "bigarray, str", "main.native"], cwd=os.path.abspath("src"))
54+
exitCode = subprocess.call(["ocamlbuild", "-libs", "bigarray, nums, str", "main.native"], cwd=os.path.abspath("src"))
5555
if (exitCode != 0):
5656
raise Exception("ocamlbuild failed with exit code %i" % exitCode)
5757
if not os.path.exists(path):
@@ -74,4 +74,4 @@ def rebuild_interpreter(path):
7474

7575
testFiles = glob.glob("test/*.wasm")
7676
generate_test_cases(RunTests, interpreterPath, testFiles)
77-
unittest.main()
77+
unittest.main()

‎ml-proto/src/Makefile

+1-1
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ MODULES = \
1212
NOMLI = flags types values ast sexpr main
1313
PARSERS = parser
1414
LEXERS = lexer
15-
LIBRARIES = bigarray str
15+
LIBRARIES = bigarray nums str
1616
SAMPLES =
1717
TEXTS =
1818

‎ml-proto/src/arithmetic.ml

+93-59
Original file line numberDiff line numberDiff line change
@@ -38,11 +38,54 @@ sig
3838
val to_int64 : t -> int64
3939
val to_float : t -> float
4040
val float_of_bits : t -> float
41+
val to_big_int_u : t -> Big_int.big_int
42+
val of_big_int_u : Big_int.big_int -> t
43+
end
44+
45+
let to_big_int_u_for size to_big_int i =
46+
let open Big_int in
47+
let value_range = Big_int.power_int_positive_int 2 size in
48+
let i' = to_big_int i in
49+
if ge_big_int i' zero_big_int then i' else add_big_int i' value_range
50+
51+
let of_big_int_u_for size of_big_int i =
52+
let open Big_int in
53+
let value_range = Big_int.power_int_positive_int 2 size in
54+
let i' = if ge_big_int i zero_big_int then i else sub_big_int i value_range
55+
in of_big_int i'
56+
57+
module Int32X =
58+
struct
59+
include Int32
60+
let size = 32
61+
let to_int32 i = i
62+
let to_int64 = Int64.of_int32
63+
let to_value i = Int32 i
64+
let of_value n =
65+
function Int32 i -> i | v -> raise (TypeError (n, v, Int32Type))
66+
let value_range = Big_int.power_int_positive_int 2 32
67+
let to_big_int_u = to_big_int_u_for size Big_int.big_int_of_int32
68+
let of_big_int_u = of_big_int_u_for size Big_int.int32_of_big_int
69+
end
70+
71+
module Int64X =
72+
struct
73+
include Int64
74+
let size = 64
75+
let to_int64 i = i
76+
let to_value i = Int64 i
77+
let of_value n =
78+
function Int64 i -> i | v -> raise (TypeError (n, v, Int64Type))
79+
let to_big_int_u = to_big_int_u_for size Big_int.big_int_of_int64
80+
let of_big_int_u = of_big_int_u_for size Big_int.int64_of_big_int
4181
end
4282

4383
module IntOp (IntOpSyntax : module type of Ast.IntOp ()) (Int : INT) =
4484
struct
4585
open IntOpSyntax
86+
open Big_int
87+
88+
let unsigned big_op i j = big_op (Int.to_big_int_u i) (Int.to_big_int_u j)
4689

4790
let unop op =
4891
let f = match op with
@@ -59,69 +102,48 @@ struct
59102
| Sub -> Int.sub
60103
| Mul -> Int.mul
61104
| DivS -> Int.div
62-
| DivU -> fun i _ -> i (* TODO *)
105+
| DivU -> fun i j -> Int.of_big_int_u (unsigned div_big_int i j)
63106
| ModS -> Int.rem
64-
| ModU -> fun i _ -> i (* TODO *)
107+
| ModU -> fun i j -> Int.of_big_int_u (unsigned mod_big_int i j)
65108
| And -> Int.logand
66109
| Or -> Int.logor
67110
| Xor -> Int.logxor
68-
| Shl -> fun x y -> Int.shift_left x (Int.to_int y)
69-
| Shr -> fun x y -> Int.shift_right_logical x (Int.to_int y)
70-
| Sar -> fun x y -> Int.shift_right x (Int.to_int y)
111+
| Shl -> fun i j -> Int.shift_left i (Int.to_int j)
112+
| Shr -> fun i j -> Int.shift_right_logical i (Int.to_int j)
113+
| Sar -> fun i j -> Int.shift_right i (Int.to_int j)
71114
in fun v1 v2 -> Int.to_value (f (Int.of_value 1 v1) (Int.of_value 2 v2))
72115

73116
let relop op =
74117
let f = match op with
75118
| Eq -> (=)
76119
| Neq -> (<>)
77120
| LtS -> (<)
78-
| LtU -> fun _ _ -> false (* TODO *)
121+
| LtU -> unsigned lt_big_int
79122
| LeS -> (<=)
80-
| LeU -> fun _ _ -> false (* TODO *)
123+
| LeU -> unsigned le_big_int
81124
| GtS -> (>)
82-
| GtU -> fun _ _ -> false (* TODO *)
125+
| GtU -> unsigned gt_big_int
83126
| GeS -> (>=)
84-
| GeU -> fun _ _ -> false (* TODO *)
127+
| GeU -> unsigned ge_big_int
85128
in fun v1 v2 -> f (Int.of_value 1 v1) (Int.of_value 2 v2)
86129

87130
let cvt op =
88131
let f = match op with
89-
| ToInt32S -> fun x -> Int32 (Int.to_int32 x)
90-
| ToInt32U -> fun _ -> Int32 Int32.zero (* TODO *)
91-
| ToInt64S -> fun x -> Int64 (Int.to_int64 x)
92-
| ToInt64U -> fun _ -> Int64 Int64.zero (* TODO *)
93-
| ToFloat32S -> fun x -> Float32 (Int.to_float x)
94-
| ToFloat32U -> fun _ -> Float32 0.0 (* TODO *)
95-
| ToFloat64S -> fun x -> Float64 (Int.to_float x)
96-
| ToFloat64U -> fun _ -> Float64 0.0 (* TODO *)
97-
| ToFloatCast -> fun x ->
132+
| ToInt32S -> fun i -> Int32 (Int.to_int32 i)
133+
| ToInt32U -> fun i -> Int32 (Int32X.of_big_int_u (Int.to_big_int_u i))
134+
| ToInt64S -> fun i -> Int64 (Int.to_int64 i)
135+
| ToInt64U -> fun i -> Int64 (Int64X.of_big_int_u (Int.to_big_int_u i))
136+
| ToFloat32S -> fun i -> Float32 (Int.to_float i)
137+
| ToFloat32U -> fun i -> Float32 (float_of_big_int (Int.to_big_int_u i))
138+
| ToFloat64S -> fun i -> Float64 (Int.to_float i)
139+
| ToFloat64U -> fun i -> Float64 (float_of_big_int (Int.to_big_int_u i))
140+
| ToFloatCast -> fun i ->
98141
if Int.size = 32
99-
then Float32 (Int.float_of_bits x)
100-
else Float64 (Int.float_of_bits x)
142+
then Float32 (Int.float_of_bits i)
143+
else Float64 (Int.float_of_bits i)
101144
in fun v -> f (Int.of_value 1 v)
102145
end
103146

104-
module Int32X =
105-
struct
106-
include Int32
107-
let size = 32
108-
let to_int32 i = i
109-
let to_int64 = Int64.of_int32
110-
let to_value i = Int32 i
111-
let of_value n =
112-
function Int32 i -> i | v -> raise (TypeError (n, v, Int32Type))
113-
end
114-
115-
module Int64X =
116-
struct
117-
include Int64
118-
let size = 64
119-
let to_int64 i = i
120-
let to_value i = Int64 i
121-
let of_value n =
122-
function Int64 i -> i | v -> raise (TypeError (n, v, Int64Type))
123-
end
124-
125147
module Int32Op = IntOp (Ast.Int32Op) (Int32X)
126148
module Int64Op = IntOp (Ast.Int64Op) (Int64X)
127149

@@ -135,6 +157,22 @@ sig
135157
val to_value : float -> value
136158
end
137159

160+
module Float32X =
161+
struct
162+
let size = 32
163+
let to_value z = Float32 z
164+
let of_value n =
165+
function Float32 z -> z | v -> raise (TypeError (n, v, Float32Type))
166+
end
167+
168+
module Float64X =
169+
struct
170+
let size = 64
171+
let to_value z = Float64 z
172+
let of_value n =
173+
function Float64 z -> z | v -> raise (TypeError (n, v, Float64Type))
174+
end
175+
138176
module FloatOp (FloatOpSyntax : module type of Ast.FloatOp ())
139177
(Float : FLOAT) =
140178
struct
@@ -174,9 +212,21 @@ struct
174212
let cvt op =
175213
let f = match op with
176214
| ToInt32S -> fun x -> Int32 (Int32.of_float x)
177-
| ToInt32U -> fun _ -> Int32 Int32.zero (* TODO *)
215+
| ToInt32U -> fun x ->
216+
let limit = Int32.to_float Int32.max_int +. 1.0 in
217+
let i =
218+
if x < 0.0 || x >= 2.0 *. limit then Int32.zero else
219+
if x < limit then Int32.of_float x else
220+
Int32.add (Int32.of_float (x -. limit +. 1.0)) Int32.max_int
221+
in Int32 i
178222
| ToInt64S -> fun x -> Int64 (Int64.of_float x)
179-
| ToInt64U -> fun _ -> Int64 Int64.zero (* TODO *)
223+
| ToInt64U -> fun x ->
224+
let limit = Int64.to_float Int64.max_int +. 1.0 in
225+
let i =
226+
if x < 0.0 || x >= 2.0 *. limit then Int64.zero else
227+
if x < limit then Int64.of_float x else
228+
Int64.add (Int64.of_float (x -. limit +. 1.0)) Int64.max_int
229+
in Int64 i
180230
| ToFloat32 -> fun x -> Float32 x
181231
| ToFloat64 -> fun x -> Float64 x
182232
| ToIntCast -> fun x ->
@@ -186,22 +236,6 @@ struct
186236
in fun v -> f (Float.of_value 1 v)
187237
end
188238

189-
module Float32X =
190-
struct
191-
let size = 32
192-
let to_value z = Float32 z
193-
let of_value n =
194-
function Float32 z -> z | v -> raise (TypeError (n, v, Float32Type))
195-
end
196-
197-
module Float64X =
198-
struct
199-
let size = 64
200-
let to_value z = Float64 z
201-
let of_value n =
202-
function Float64 z -> z | v -> raise (TypeError (n, v, Float64Type))
203-
end
204-
205239
module Float32Op = FloatOp (Ast.Float32Op) (Float32X)
206240
module Float64Op = FloatOp (Ast.Float64Op) (Float64X)
207241

‎ml-proto/test/unsigned.ml

+75
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
(module
2+
(func $divmod (param $i i64) (param $j i64) (result i64 i64 i64 i64)
3+
(return
4+
(divs.i64 (getlocal $i) (getlocal $j))
5+
(divu.i64 (getlocal $i) (getlocal $j))
6+
(mods.i64 (getlocal $i) (getlocal $j))
7+
(modu.i64 (getlocal $i) (getlocal $j))
8+
)
9+
)
10+
11+
(func $compare (param $i i64) (param $j i64) (result i32 i32 i32 i32)
12+
(return
13+
(lts.i64 (getlocal $i) (getlocal $j))
14+
(ltu.i64 (getlocal $i) (getlocal $j))
15+
(ges.i64 (getlocal $i) (getlocal $j))
16+
(geu.i64 (getlocal $i) (getlocal $j))
17+
)
18+
)
19+
20+
(func $cvt_float (param $x f64) (result i32 i64)
21+
(return (convertu.f64.i32 (getlocal $x)) (convertu.f64.i64 (getlocal $x)))
22+
)
23+
24+
(export "divmod" $divmod)
25+
(export "compare" $compare)
26+
(export "cvt_float" $cvt_float)
27+
)
28+
29+
(asserteq
30+
(invoke "divmod"
31+
(add.i64 (const.i64 9223372036854775807) (const.i64 2)) ;; max_int64+2
32+
(const.i64 1000)
33+
)
34+
(const.i64 -9223372036854775) ;; divs
35+
(const.i64 9223372036854775) ;; divu
36+
(const.i64 -807) ;; divs
37+
(const.i64 809) ;; divu
38+
)
39+
40+
(asserteq
41+
(invoke "compare"
42+
(add.i64 (const.i64 9223372036854775807) (const.i64 1)) ;; max_int64+1
43+
(const.i64 9223372036854775807)
44+
)
45+
(const.i32 1) ;; lts
46+
(const.i32 0) ;; ltu
47+
(const.i32 0) ;; ges
48+
(const.i32 1) ;; geu
49+
)
50+
51+
(asserteq (invoke "cvt_float" (const.f64 1e8))
52+
(const.i32 100000000) (const.i64 100000000)
53+
)
54+
55+
(asserteq (invoke "cvt_float" (const.f64 1e16))
56+
(const.i32 0) (const.i64 10000000000000000)
57+
)
58+
59+
(asserteq (invoke "cvt_float" (const.f64 1e30))
60+
(const.i32 0) (const.i64 0)
61+
)
62+
63+
(asserteq (invoke "cvt_float" (const.f64 -1))
64+
(const.i32 0) (const.i64 0)
65+
)
66+
67+
(asserteq
68+
(invoke "cvt_float" (const.f64 4294967295)) ;; max_uint32
69+
(const.i32 -1) (const.i64 4294967295)
70+
)
71+
72+
(asserteq
73+
(invoke "cvt_float" (const.f64 9223372036854775808)) ;; max_int64+1
74+
(const.i32 0) (const.i64 -9223372036854775808)
75+
)

‎ml-proto/travis/build-test.sh

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ export PATH=$PWD/ocaml/install/bin:$PATH
1111

1212
cd src
1313

14-
ocamlbuild -libs "bigarray, str" main.native
14+
ocamlbuild -libs "bigarray, nums, str" main.native
1515

1616
cd ..
1717

0 commit comments

Comments
 (0)