Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 25 additions & 1 deletion lib/bap/bap.mli
Original file line number Diff line number Diff line change
Expand Up @@ -1235,9 +1235,33 @@ module Std : sig
expected from integral values. *)
include Integer.S with type t := t

(** A comparable interface with size-monomorphic comparison. *)
(** The comparable interface with size-monomorphic comparison. *)
module Mono : Comparable with type t := t


(** The comparable interface using the unsigned order.

@since 2.5.0 *)
module Unsigned : sig
include Binable.S with type t = t
include Comparable.S_binable with type t := t
include Hashable.S_binable with type t := t
end

(** The comparable interface using the literal order.

In this order the bitvectors are compared literally, so that
bitvectors of different sizes but with equal values will be
different. This is the fastest order.

@since 2.5.0 *)
module Literal : sig
include Binable.S with type t = t
include Comparable.S_binable with type t := t
include Hashable.S_binable with type t := t
end


(** Specifies the order of bytes in a word. *)
type endian =
| LittleEndian (** least significant byte comes first *)
Expand Down
38 changes: 31 additions & 7 deletions lib/bap_types/bap_bitvector.ml
Original file line number Diff line number Diff line change
Expand Up @@ -157,7 +157,7 @@ let data_word t x = create x (Theory.Target.bits t) [@@inline]
let to_bitvec x = Packed.payload x [@@inline]
let unsigned x = x [@@inline]
let signed x = Packed.signed x [@@inline]
let hash x = Packed.hash x [@@inline]
let hash x = Bitvec.hash (Packed.payload x) [@@inline]
let bits_of_z x = Bitvec.to_binary (Packed.payload x)
let unop op t = Packed.lift1 t op [@@inline]
let binop op t1 t2 = Packed.lift2 t1 t2 op [@@inline]
Expand Down Expand Up @@ -271,20 +271,26 @@ type packed = Packed.t [@@deriving bin_io]
let sexp_of_packed = Sexp_hum.sexp_of_t
let packed_of_sexp = Sexp_hum.t_of_sexp


let compare_literal = Packed.compare

let compare_unsigned x y =
Bitvec.compare (payload x) (payload y)
[@@inline]

let compare_signed x y =
if phys_equal x y then 0
else match Packed.compare x y with
else
match compare_literal x y with
| 0 -> 0
| r ->
| _ ->
if is_signed x || is_signed y then
let x_is_neg = msb x and y_is_neg = msb y in
match x_is_neg, y_is_neg with
| true,false -> -1
| false,true -> 1
| _ -> Bitvec.compare (payload x) (payload y)
else r


| _ -> compare_unsigned x y
else compare_unsigned x y

let with_validation t ~f = Or_error.map ~f (Validate.result t)

Expand Down Expand Up @@ -628,6 +634,23 @@ module Trie = struct
end
end

module Literal = struct
type t = packed [@@deriving bin_io, sexp]
include Comparable.Make_binable(Packed)
include Hashable.Make_binable_and_derive_hash_fold_t(Packed)
end

module Unsigned = struct
module Order = struct
type t = packed [@@deriving bin_io,sexp]
let compare = compare_unsigned
let hash = hash
end
include Comparable.Make_binable(Order)
include Hashable.Make_binable_and_derive_hash_fold_t(Order)
include Order
end

include Or_error.Monad_infix
include Regular.Make(struct
type t = packed [@@deriving bin_io, sexp]
Expand Down Expand Up @@ -698,6 +721,7 @@ module Stable = struct
end



let to_string = string_of_word
let of_string = word_of_string

Expand Down
10 changes: 10 additions & 0 deletions lib/bap_types/bap_bitvector.mli
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,16 @@ type endian =
include Regular.S with type t := t
include Bap_integer.S with type t := t
module Mono : Comparable.S with type t := t
module Unsigned : sig
include Binable.S with type t = t
include Comparable.S_binable with type t := t
include Hashable.S_binable with type t := t
end
module Literal : sig
include Binable.S with type t = t
include Comparable.S_binable with type t := t
include Hashable.S_binable with type t := t
end

val create : Bitvec.t -> int -> t

Expand Down