diff --git a/ml-proto/src/spec/arithmetic.ml b/ml-proto/src/spec/arithmetic.ml index 234a07cebc..de94b6bdd3 100644 --- a/ml-proto/src/spec/arithmetic.ml +++ b/ml-proto/src/spec/arithmetic.ml @@ -33,6 +33,7 @@ sig val shift_right : t -> int -> t val shift_right_logical : t -> int -> t val to_int : t -> int + val of_int : int -> t val of_int32 : int32 -> t val of_int64 : int64 -> t val to_float : t -> float @@ -42,6 +43,8 @@ sig val of_big_int_u : Big_int.big_int -> t val to_value : t -> value val of_value : int -> value -> t + val zero : t + val one : t end let to_big_int_u_for size to_big_int i = @@ -118,11 +121,35 @@ struct let unsigned big_op i j = big_op (Int.to_big_int_u i) (Int.to_big_int_u j) let unop op = + let open Int in let f = match op with - | Clz -> fun i -> i (* TODO *) - | Ctz -> fun i -> i (* TODO *) - | Popcnt -> fun i -> i (* TODO *) - in fun v -> Int.to_value (f (Int.of_value 1 v)) + | Clz -> + let rec loop acc n = + if n = zero then + size + else if logand n (shift_left one (size - 1)) <> zero then + acc + else + loop (1 + acc) (shift_left n 1) + in loop 0 + | Ctz -> + let rec loop acc n = + if n = zero then + size + else if logand n one = one then + acc + else + loop (1 + acc) (shift_right_logical n 1) + in loop 0 + | Popcnt -> + let rec loop acc i n = + if n = zero then + acc + else + let acc' = if logand n one = one then acc + 1 else acc in + loop acc' (i - 1) (shift_right_logical n 1) + in loop 0 size + in fun v -> to_value (of_int (f (of_value 1 v))) let binop op = let f = match op with diff --git a/ml-proto/test/int32.wasm b/ml-proto/test/int32.wasm new file mode 100644 index 0000000000..46463d8250 --- /dev/null +++ b/ml-proto/test/int32.wasm @@ -0,0 +1,37 @@ +(; Int arith operations ;) + +(module + (func $clz (param $x i32) (result i32) + (i32.clz (get_local $x)) + ) + + (func $ctz (param $x i32) (result i32) + (i32.ctz (get_local $x)) + ) + + (func $popcnt (param $x i32) (result i32) + (i32.popcnt (get_local $x)) + ) + + (export "clz" $clz) + (export "ctz" $ctz) + (export "popcnt" $popcnt) +) + +(assert_eq (invoke "clz" (i32.const -1)) (i32.const 0)) ;; 0xFFFFFFFF +(assert_eq (invoke "clz" (i32.const 0)) (i32.const 32)) +(assert_eq (invoke "clz" (i32.const 32768)) (i32.const 16)) ;; 0x00008000 +(assert_eq (invoke "clz" (i32.const 255)) (i32.const 24)) ;; 0xFF +(assert_eq (invoke "clz" (i32.const -2147483648)) (i32.const 0)) ;; 0x80000000 +(assert_eq (invoke "clz" (i32.const 1)) (i32.const 31)) +(assert_eq (invoke "clz" (i32.const 2)) (i32.const 30)) + +(assert_eq (invoke "ctz" (i32.const -1)) (i32.const 0)) +(assert_eq (invoke "ctz" (i32.const 0)) (i32.const 32)) +(assert_eq (invoke "ctz" (i32.const 32768)) (i32.const 15)) ;; 0x00008000 +(assert_eq (invoke "ctz" (i32.const 65536)) (i32.const 16)) ;; 0x00010000 +(assert_eq (invoke "ctz" (i32.const -2147483648)) (i32.const 31)) ;; 0x80000000 + +(assert_eq (invoke "popcnt" (i32.const -1)) (i32.const 32)) +(assert_eq (invoke "popcnt" (i32.const 0)) (i32.const 0)) +(assert_eq (invoke "popcnt" (i32.const 32768)) (i32.const 1)) ;; 0x00008000