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
(* SPDX-License-Identifier: Apache-2.0 *)
(* Copyright 2017 WebAssembly Community Group participants *)
(* This file is originally from the WebAssembly reference interpreter available at https://github.com/WebAssembly/spec/tree/main/interpreter *)
(* SPDX-License-Identifier: MIT *)
(* Copyright (c) 2016--2024 Jane Street Group, LLC <opensource-contacts@janestreet.com> *)
(* The code of the `popcnt` function is originally from the `base` library available at https://github.com/janestreet/base *)
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2024 OCamlPro *)
(* Modified by the Owi programmers *)
include Prelude.Int32
let clz n = of_int (Ocaml_intrinsics.Int32.count_leading_zeros n)
let ctz n = of_int (Ocaml_intrinsics.Int32.count_trailing_zeros n)
(* Taken from Base *)
let popcnt =
let mask = 0xffff_ffffL in
fun[@inline] x ->
Int64.to_int32 (Int64.popcnt (Int64.logand (Int64.of_int32 x) mask))
let to_int64 n = Int64.of_int32 n [@@inline]
let eq (x : int32) y = equal x y [@@inline]
let ne (x : int32) y = compare x y <> 0 [@@inline]
let lt (x : int32) y = compare x y < 0 [@@inline]
let le (x : int32) y = compare x y <= 0 [@@inline]
let lt_u (x : int32) y = unsigned_compare x y < 0 [@@inline]
let le_u (x : int32) y = unsigned_compare x y <= 0 [@@inline]
(* In OCaml, `shift_{left,right,right_logical} are unspecified if y < 0 or y >= 32, but they're not in Wasm and thus we need to mask `y`` to only keep the low 5 bits. *)
let shl x y = shift_left x (to_int (logand y 31l)) [@@inline]
let ashr x y = shift_right x (to_int (logand y 31l)) [@@inline]
let lshr x y = shift_right_logical x (to_int (logand y 31l)) [@@inline]
let rotate_left x y =
let n = logand y 31l in
logor (shl x n) (lshr x (sub 32l n))
[@@inline]
let rotate_right x y =
let n = logand y 31l in
logor (lshr x n) (shl x (sub 32l n))
[@@inline]
let extend_s n x =
let shift = 32 - n in
shift_right (shift_left x shift) shift
[@@inline]
(* String conversion that allows leading signs and unsigned values *)
let max_upper = unsigned_div minus_one 10l
let max_lower = unsigned_rem minus_one 10l
let sign_extend i =
let sign_bit = logand (of_int (1 lsl (32 - 1))) i in
if eq sign_bit zero then i
else
(* Build a sign-extension mask *)
let sign_mask = shift_left minus_one 32 in
logor sign_mask i
let of_string_exn s =
let len = String.length s in
let rec parse_hex i num =
if i = len then num
else
let c = s.[i] in
if Char.equal c '_' then parse_hex (i + 1) num
else begin
let digit = of_int (Char.Ascii.hex_digit_to_int c) in
if not (le_u num (lshr minus_one (of_int 4))) then
Fmt.failwith "of_string (int32)"
else parse_hex (i + 1) (logor (shift_left num 4) digit)
end
in
let rec parse_dec i num =
if i = len then num
else
let c = s.[i] in
if Char.equal c '_' then parse_dec (i + 1) num
else begin
let digit = of_int (Char.Ascii.digit_to_int c) in
if not (lt_u num max_upper || (eq num max_upper && le_u digit max_lower))
then Fmt.failwith "of_string (int32)"
else parse_dec (i + 1) (add (mul num 10l) digit)
end
in
let parse_int i =
if not (len - i > 0) then Fmt.failwith "of_string (int32)"
else if i + 2 <= len && Char.equal s.[i] '0' && Char.equal s.[i + 1] 'x'
then parse_hex (i + 2) zero
else parse_dec i zero
in
let parsed =
match s.[0] with
| '+' -> parse_int 1
| '-' ->
let n = parse_int 1 in
if not (le minus_one (sub n one)) then Fmt.failwith "of_string (int32)"
else neg n
| _ -> parse_int 0
in
sign_extend parsed
let of_string s = try Some (of_string_exn s) with Failure _ -> None
let to_string_u = Fmt.str "%lu"