package binsec

  1. Overview
  2. Docs
package binsec
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file basic_types.ml

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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
(**************************************************************************)
(*  This file is part of BINSEC.                                          *)
(*                                                                        *)
(*  Copyright (C) 2016-2026                                               *)
(*    CEA (Commissariat à l'énergie atomique et aux énergies              *)
(*         alternatives)                                                  *)
(*                                                                        *)
(*  you can redistribute it and/or modify it under the terms of the GNU   *)
(*  Lesser General Public License as published by the Free Software       *)
(*  Foundation, version 2.1.                                              *)
(*                                                                        *)
(*  It is distributed in the hope that it will be useful,                 *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU Lesser General Public License for more details.                   *)
(*                                                                        *)
(*  See the GNU Lesser General Public License version 2.1                 *)
(*  for more details (enclosed in the file licenses/LGPLv2.1).            *)
(*                                                                        *)
(**************************************************************************)

type endianness = LittleEndian | BigEndian

module MapSetMaker (C : Sigs.COMPARABLE) = struct
  module Map = struct
    include Map.Make (C)

    let pop m =
      let ((k, _) as elt) = choose m in
      (elt, remove k m)

    let keys m = fold (fun k _ acc -> k :: acc) m [] |> List.rev
    let values m = fold (fun _ v acc -> v :: acc) m [] |> List.rev
  end

  module Set = struct
    include Set.Make (C)

    let pop set =
      let a = choose set in
      (a, remove a set)
  end
end

module Collection_make = struct
  module Hashed (C : Sigs.HASHABLE) = struct
    include C
    include MapSetMaker (C)

    module Htbl = struct
      include Hashtbl.Make (C)

      let filter p h =
        let h' = create (length h) in
        iter (fun k v -> if p k v then add h' k v) h;
        h'

      let bindings h = fold (fun k v acc -> (k, v) :: acc) h []
    end
  end

  module Auto (C : Sigs.COMPARABLE_EXT) = Hashed (struct
    include C

    let hash = Hashtbl.hash
  end)

  module Default (C : Sigs.COMPARABLE) = Auto (struct
    include C

    let equal a b = compare a b = 0
  end)
end

type 'a interval = { lo : 'a; hi : 'a }

module Integers = struct
  type uint8 = int
  type uint16 = int
  type uint32 = int32
  type uint64 = int64
  type int8 = int
  type int16 = int

  module type S = sig
    type t

    val to_uint8 : t -> uint8
    val to_uint16 : t -> uint16
    val to_uint32 : t -> uint32
    val to_uint64 : t -> uint64
    val to_int8 : t -> int8
    val to_int16 : t -> int16
    val to_int32 : t -> int32
    val to_int64 : t -> int64
    val to_int : t -> int
    val to_bigint : t -> Z.t
  end

  module Uint8 : sig
    include S with type t = uint8

    external to_char : t -> char = "%identity"
    external to_int : t -> int = "%identity"
  end = struct
    type t = uint8

    external to_char : t -> char = "%identity"

    let to_uint8 = Fun.id
    let to_uint16 = Fun.id
    let to_uint32 = Int32.of_int
    let to_uint64 = Int64.of_int
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64

    external to_int : t -> int = "%identity"

    let to_bigint = Z.of_int
  end

  module Uint16 : sig
    include S with type t = uint16

    external to_int : t -> int = "%identity"
  end = struct
    type t = uint16

    let to_uint8 x = x land 0xff
    let to_uint16 = Fun.id
    let to_uint32 = Int32.of_int
    let to_uint64 = Int64.of_int
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64

    external to_int : t -> int = "%identity"

    let to_bigint = Z.of_int
  end

  module Uint32 : S with type t = uint32 = struct
    type t = uint32

    let to_uint8 x = Int32.to_int (Int32.logand x 0xffl)
    let to_uint16 x = Int32.to_int (Int32.logand x 0xffffl)
    let to_uint32 = Fun.id
    let to_uint64 x = Int64.logand (Int64.of_int32 x) 0xffffffffL
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64
    let to_bigint x = Z.of_int32_unsigned x
    let to_int x = Z.to_int (to_bigint x)
  end

  module Uint64 : S with type t = uint64 = struct
    type t = uint64

    let to_uint8 x = Int64.to_int (Int64.logand x 0xffL)
    let to_uint16 x = Int64.to_int (Int64.logand x 0xffffL)
    let to_uint32 x = Int64.to_int32 (Int64.logand x 0xffffffffL)
    let to_uint64 = Fun.id
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64
    let to_bigint x = Z.of_int64_unsigned x
    let to_int x = Z.to_int (to_bigint x)
  end

  module Int8 : S with type t = int8 = struct
    type t = int8

    let to_int x = (x lxor 0x80) - 0x80
    let to_uint8 = Fun.id
    let to_uint16 x = to_int x land 0xffff
    let to_uint32 x = Int32.of_int (to_int x)
    let to_uint64 x = Int64.of_int (to_int x)
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64
    let to_bigint x = Z.of_int (to_int x)
  end

  module Int16 : S with type t = int16 = struct
    type t = int16

    let to_int x = (x lxor 0x8000) - 0x8000
    let to_uint8 = Uint16.to_int8
    let to_uint16 = Fun.id
    let to_uint32 x = Int32.of_int (to_int x)
    let to_uint64 x = Int64.of_int (to_int x)
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64
    let to_bigint x = Z.of_int (to_int x)
  end

  module Int32 : sig
    include module type of Int32
    include S with type t = int32
  end = struct
    include Int32

    let to_uint8 = Uint32.to_uint8
    let to_uint16 = Uint32.to_uint16
    let to_uint32 = Fun.id
    let to_uint64 = Int64.of_int32
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64
    let to_bigint = Z.of_int32
  end

  module Int64 : sig
    include module type of Int64
    include S with type t = int64
  end = struct
    include Int64

    let to_uint8 = Uint64.to_uint8
    let to_uint16 = Uint64.to_uint16
    let to_uint32 = Uint64.to_uint32
    let to_uint64 = Fun.id
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64
    let to_bigint = Z.of_int64
  end

  module Int : sig
    include Collection.S with type t = int
    include S with type t := int

    external unsafe_to_uint8 : t -> uint8 = "%identity"
  end = struct
    include Collection_make.Auto (Int)

    let to_uint8 x = x land 0xff
    let to_uint16 x = x land 0xffff
    let to_uint32 = Int32.of_int
    let to_uint64 = Int64.of_int
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_int32 = to_uint32
    let to_int64 = to_uint64
    let to_int = Fun.id
    let to_bigint = Z.of_int

    external unsafe_to_uint8 : t -> uint8 = "%identity"
  end

  module Bigint : sig
    include module type of Z
    include Collection.S with type t := Z.t
    include S with type t := Z.t
  end = struct
    include Z
    include Collection.Hashed (Z)

    let to_uint8 x = Z.to_int (Z.extract x 0 8)
    let to_uint16 x = Z.to_int (Z.extract x 0 16)
    let to_uint32 = to_int32_unsigned
    let to_uint64 = to_int64_unsigned
    let to_int8 = to_uint8
    let to_int16 = to_uint16
    let to_bigint = Fun.id
  end
end

module Constants = struct
  let bytesize = Natural.create 8
end

module Float = Collection_make.Default (Float)
module String = Collection_make.Auto (String)

module Ternary = struct
  type t = Domains.trilean = False | True | Unknown

  let of_bool = function true -> True | false -> False

  let to_bool ?(unknown = false) = function
    | True -> true
    | False -> false
    | Unknown -> unknown

  let lognot = function True -> False | False -> True | Unknown -> Unknown

  let logand t1 t2 =
    match (t1, t2) with
    | True, True -> True
    | _, False | False, _ -> False
    | _, _ -> Unknown

  let logor t1 t2 =
    match (t1, t2) with
    | False, False -> False
    | True, _ | _, True -> True
    | _, _ -> Unknown
end