Commit 004d61b8 authored by David Bühler's avatar David Bühler
Browse files

[Ival] Do not export the ival type.

Exports 4 new functions in ival:
- is_int and is_float
- is_small_set and project_small_set
parent 42748391
...@@ -92,6 +92,12 @@ type pre_set = ...@@ -92,6 +92,12 @@ type pre_set =
type t = type t =
| Set of Int.t array | Set of Int.t array
| Float of Fval.t | Float of Fval.t
(* [Top(min, max, rem, modulo)] represents the interval between
[min] and [max], congruent to [rem] modulo [modulo]. A value of
[None] for [min] (resp. [max]) represents -infinity
(resp. +infinity). [modulo] is > 0, and [0 <= rem < modulo].
Actual [Top] is thus represented by Top(None,None,Int.zero,Int.one) *)
| Top of Int.t option * Int.t option * Int.t * Int.t | Top of Int.t option * Int.t option * Int.t * Int.t
(* Binary abstract operations do not model precisely float/integer operations. (* Binary abstract operations do not model precisely float/integer operations.
It is the responsibility of the callers to have two operands of the same It is the responsibility of the callers to have two operands of the same
...@@ -326,6 +332,15 @@ let project_float v = ...@@ -326,6 +332,15 @@ let project_float v =
| Float f -> f | Float f -> f
| Top _ | Set _ -> assert false (* by hypothesis that it is a float *) | Top _ | Set _ -> assert false (* by hypothesis that it is a float *)
let is_float = function
| Float _ -> true
| Top _ -> false
| Set _ as i -> equal zero i || equal bottom i
let is_int = function
| Top _ | Set _ -> true
| Float _ -> false
let in_interval x min max r modu = let in_interval x min max r modu =
Int.equal (Int.e_rem x modu) r && min_le_elt min x && max_ge_elt max x Int.equal (Int.e_rem x modu) r && min_le_elt min x && max_ge_elt max x
...@@ -362,6 +377,14 @@ let project_int v = match v with ...@@ -362,6 +377,14 @@ let project_int v = match v with
| Set [| e |] -> e | Set [| e |] -> e
| _ -> raise Not_Singleton_Int | _ -> raise Not_Singleton_Int
let is_small_set = function
| Set _ -> true
| _ -> false
let project_small_set = function
| Set a -> Some (Array.to_list a)
| _ -> None
let cardinal v = let cardinal v =
match v with match v with
| Top (None,_,_,_) | Top (_,None,_,_) -> None | Top (None,_,_,_) | Top (_,None,_,_) -> None
...@@ -590,12 +613,8 @@ let min_and_max_float t = ...@@ -590,12 +613,8 @@ let min_and_max_float t =
| Float f -> Fval.min_and_max f | Float f -> Fval.min_and_max f
| _ -> assert false | _ -> assert false
let is_float = function
| Float _ -> true
| Set _ | Top _ -> false
let has_greater_min_bound t1 t2 = let has_greater_min_bound t1 t2 =
if is_float t1 || is_float t2 if is_float t1 && is_float t2
then Fval.has_greater_min_bound (project_float t1) (project_float t2) then Fval.has_greater_min_bound (project_float t1) (project_float t2)
else else
let m1, _ = min_and_max t1 in let m1, _ = min_and_max t1 in
...@@ -607,7 +626,7 @@ let has_greater_min_bound t1 t2 = ...@@ -607,7 +626,7 @@ let has_greater_min_bound t1 t2 =
| Some m1, Some m2 -> Int.compare m1 m2 | Some m1, Some m2 -> Int.compare m1 m2
let has_smaller_max_bound t1 t2 = let has_smaller_max_bound t1 t2 =
if is_float t1 || is_float t2 if is_float t1 && is_float t2
then Fval.has_smaller_max_bound (project_float t1) (project_float t2) then Fval.has_smaller_max_bound (project_float t1) (project_float t2)
else else
let _, m1 = min_and_max t1 in let _, m1 = min_and_max t1 in
......
...@@ -26,16 +26,7 @@ ...@@ -26,16 +26,7 @@
open Abstract_interp open Abstract_interp
type t = private type t
| Set of Int.t array
| Float of Fval.t
(** [Top(min, max, rem, modulo)] represents the interval between
[min] and [max], congruent to [rem] modulo [modulo]. A value of
[None] for [min] (resp. [max]) represents -infinity
(resp. +infinity). [modulo] is > 0, and [0 <= rem < modulo].
Actual [Top] is thus represented by Top(None,None,Int.zero,Int.one) *)
| Top of Int.t option * Int.t option * Int.t * Int.t
(** {2 General guidelines of this module} (** {2 General guidelines of this module}
...@@ -68,6 +59,9 @@ include Lattice_type.Full_AI_Lattice_with_cardinality ...@@ -68,6 +59,9 @@ include Lattice_type.Full_AI_Lattice_with_cardinality
val is_bottom : t -> bool val is_bottom : t -> bool
val overlaps: partial:bool -> size:Integer.t -> t -> t -> bool val overlaps: partial:bool -> size:Integer.t -> t -> t -> bool
val is_float: t -> bool
val is_int: t -> bool
val add_int : t -> t -> t val add_int : t -> t -> t
(** Addition of two integer (ie. not [Float]) ivals. *) (** Addition of two integer (ie. not [Float]) ivals. *)
val add_int_under : t -> t -> t val add_int_under : t -> t -> t
...@@ -175,6 +169,10 @@ val project_int : t -> Integer.t ...@@ -175,6 +169,10 @@ val project_int : t -> Integer.t
(** @raise Not_Singleton_Int when the cardinal of the argument is not 1, (** @raise Not_Singleton_Int when the cardinal of the argument is not 1,
or if it is not an integer. *) or if it is not an integer. *)
val is_small_set: t -> bool
val project_small_set: t -> Integer.t list option
val cardinal: t -> Integer.t option val cardinal: t -> Integer.t option
(** [cardinal v] returns [n] if [v] has finite cardinal [n], or [None] if (** [cardinal v] returns [n] if [v] has finite cardinal [n], or [None] if
the cardinal is not finite. *) the cardinal is not finite. *)
......
...@@ -2061,14 +2061,17 @@ let update_under ~validity ~exact ~offsets ~size v t = ...@@ -2061,14 +2061,17 @@ let update_under ~validity ~exact ~offsets ~size v t =
let paste_slice ~validity ~exact ~from:src ~size ~offsets dst = let paste_slice ~validity ~exact ~from:src ~size ~offsets dst =
if Int.(equal size zero) then (* nothing to do *) `Value dst if Int.(equal size zero) then (* nothing to do *) `Value dst
else else
match offsets, src with let size_ok =
Ival.is_singleton_int offsets
|| let _, _, _, modu = Ival.min_max_r_mod offsets in size =~ modu
in
match src with
(*Special case: [from] contains a single (aligned) binding [v], and [size] (*Special case: [from] contains a single (aligned) binding [v], and [size]
matches the periodicity of [offsets] and the size of [v]. In this case, matches the periodicity of [offsets] and the size of [v]. In this case,
it is more efficient to perform an interval update instead of an it is more efficient to perform an interval update instead of an
offsetmap copy. *) offsetmap copy. *)
| Ival.Top (_,_,_, offperiod), Node(_,_, Empty,_, Empty, vrem, vsize, v,_) | Node (_,_, Empty,_, Empty, vrem, vsize, v,_)
when Rel.is_zero vrem && size =~ offperiod && when Rel.is_zero vrem && size_ok && (size =~ vsize || V.is_isotropic v)
(size =~ vsize || V.is_isotropic v)
-> ->
update ~validity ~exact ~offsets ~size v dst update ~validity ~exact ~offsets ~size v dst
| _ -> | _ ->
...@@ -2708,15 +2711,11 @@ module Int_Intervals = struct ...@@ -2708,15 +2711,11 @@ module Int_Intervals = struct
in in
Intervals (curr_off', i, min, max) Intervals (curr_off', i, min, max)
in in
match ival with try
| Ival.Top(None, _, _, _) | Ival.Top(_, None, _, _) | Ival.Float _ -> top match Ival.min_and_max ival with
| Ival.Top(Some mn, Some mx, _r, _m) -> | None, _ | _, None -> top
aux_min_max mn mx | Some min, Some max -> aux_min_max min max
| Ival.Set(s) -> with Error_Bottom -> bottom
if Array.length s > 0 then
aux_min_max s.(0) s.(Array.length s - 1)
else
bottom
in in
Cache.merge from_ival_size_aux Cache.merge from_ival_size_aux
...@@ -2735,18 +2734,19 @@ module Int_Intervals = struct ...@@ -2735,18 +2734,19 @@ module Int_Intervals = struct
match size with match size with
| Int_Base.Top -> Bottom (* imprecise *) | Int_Base.Top -> Bottom (* imprecise *)
| Int_Base.Value size -> | Int_Base.Value size ->
match ival with if Ival.is_small_set ival
| Ival.Top(None, _, _, _) | Ival.Top(_, None, _, _) | Ival.Float _ -> then from_ival_size_over_cached ival size (* precise *)
Bottom (* imprecise *) else
| Ival.Set _ -> from_ival_size_over_cached ival size (* precise *) match Ival.min_and_max ival with
| Ival.Top (Some min, Some start_max, _, _) -> | None, _ | _, None -> Bottom (* imprecise *)
(* See if using [from_ival_size] would cause an approximation *) | Some min, Some start_max ->
let max = pred (start_max +~ size) in (* See if using [from_ival_size] would cause an approximation *)
let validity = Base.Known (min, max) in let max = pred (start_max +~ size) in
let offsets = Tr_offset.trim_by_validity ival size validity in let validity = Base.Known (min, max) in
if Int_Intervals_Map.update_aux_tr_offsets_approximates offsets size let offsets = Tr_offset.trim_by_validity ival size validity in
then bottom (* imprecise *) if Int_Intervals_Map.update_aux_tr_offsets_approximates offsets size
else from_ival_size_over_cached ival size (* precise *) then bottom (* imprecise *)
else from_ival_size_over_cached ival size (* precise *)
let range_covers_whole_type typ itvs = let range_covers_whole_type typ itvs =
match project_singleton itvs with match project_singleton itvs with
......
...@@ -47,10 +47,10 @@ let reduce_offset_by_validity origin ival size validity = ...@@ -47,10 +47,10 @@ let reduce_offset_by_validity origin ival size validity =
let max_valid = Int.sub max (Int.pred size) in let max_valid = Int.sub max (Int.pred size) in
let valid_range = Ival.inject_range (Some min) (Some max_valid) in let valid_range = Ival.inject_range (Some min) (Some max_valid) in
let reduced_ival = Ival.narrow ival valid_range in let reduced_ival = Ival.narrow ival valid_range in
match reduced_ival with match Ival.project_small_set reduced_ival with
| Ival.Float _ -> assert false | Some l -> if l = [] then Invalid else Set l
| Ival.Set s -> if s = [||] then Invalid else Set (Array.to_list s) | None ->
| Ival.Top (min, max, _r, modu) -> let min, max, _r, modu = Ival.min_max_r_mod reduced_ival in
(* The bounds are finite thanks to the narrow with the valid range. *) (* The bounds are finite thanks to the narrow with the valid range. *)
let min = Extlib.the min and max = Extlib.the max in let min = Extlib.the min and max = Extlib.the max in
if Int.lt modu size if Int.lt modu size
......
...@@ -37,11 +37,11 @@ let frama_C_is_base_aligned state actuals = ...@@ -37,11 +37,11 @@ let frama_C_is_base_aligned state actuals =
match actuals with match actuals with
| [_,x,_; _,y,_] -> | [_,x,_; _,y,_] ->
let i = Cvalue.V.project_ival y in let i = Cvalue.V.project_ival y in
begin match i with begin match Ival.project_small_set i with
| Ival.Set si -> | Some si ->
Location_Bytes.fold_i Location_Bytes.fold_i
(fun b _o () -> (fun b _o () ->
Array.iter List.iter
(fun int -> (fun int ->
if not (Base.is_aligned_by b int) if not (Base.is_aligned_by b int)
then raise Found_misaligned_base) then raise Found_misaligned_base)
...@@ -54,7 +54,7 @@ let frama_C_is_base_aligned state actuals = ...@@ -54,7 +54,7 @@ let frama_C_is_base_aligned state actuals =
c_from = None; c_from = None;
c_cacheable = Value_types.Cacheable; c_cacheable = Value_types.Cacheable;
} }
| _ -> raise Found_misaligned_base | None -> raise Found_misaligned_base
end end
| _ -> raise (Builtins.Invalid_nb_of_args 2) | _ -> raise (Builtins.Invalid_nb_of_args 2)
end end
......
...@@ -80,13 +80,14 @@ let read_exact_char ~offset ~from = ...@@ -80,13 +80,14 @@ let read_exact_char ~offset ~from =
let min = Integer.max (the_max_int from) (pos_min_int offset) in let min = Integer.max (the_max_int from) (pos_min_int offset) in
let offset = backward_comp_left Comp.Le offset min in let offset = backward_comp_left Comp.Le offset min in
let length = Ival.sub_int offset from in let length = Ival.sub_int offset from in
match offset with if not (Ival.is_singleton_int offset)
| Ival.Top (_min, _max, _rem, modu) -> then
let _, _, _, modu = Ival.min_max_r_mod offset in
let start_length = Integer.sub (pos_min_int offset) (pos_min_int from) in let start_length = Integer.sub (pos_min_int offset) (pos_min_int from) in
let max_length = Integer.max start_length modu in let max_length = Integer.max start_length modu in
let length = backward_comp_left Comp.Lt length max_length in let length = backward_comp_left Comp.Lt length max_length in
offset, length offset, length
| _ -> offset, length else offset, length
(* Checks if some limits are reached after a read at [offset]. In this case, (* Checks if some limits are reached after a read at [offset]. In this case,
adds these limits as possible lengths in [t], and adds null to [t]. *) adds these limits as possible lengths in [t], and adds null to [t]. *)
......
...@@ -846,6 +846,11 @@ module G = struct ...@@ -846,6 +846,11 @@ module G = struct
with Cvalue.V.Not_based_on_null | Ival.Not_Singleton_Int -> with Cvalue.V.Not_based_on_null | Ival.Not_Singleton_Int ->
raise Untranslatable raise Untranslatable
let has_variable_validity b =
match Base.validity b with
| Base.Variable _ -> true
| _ -> false
(* Check that [v] is an integer, or a single pointer (invariant 2 of MV). (* Check that [v] is an integer, or a single pointer (invariant 2 of MV).
Pointers to a single base with variable validity are also ruled out, as Pointers to a single base with variable validity are also ruled out, as
the base may become weak, making the pointer imprecise and thus breaking the base may become weak, making the pointer imprecise and thus breaking
...@@ -853,11 +858,8 @@ module G = struct ...@@ -853,11 +858,8 @@ module G = struct
let sanitize_v v = let sanitize_v v =
try try
let b, i = Cvalue.V.find_lonely_key v in let b, i = Cvalue.V.find_lonely_key v in
let validity = Base.validity b in if not (Ival.is_int i) || has_variable_validity b
match validity, i with then raise Untranslatable
| Base.Variable _, _
| _, Ival.Float _ -> raise Untranslatable
| _, _ -> ()
with Not_found -> raise Untranslatable with Not_found -> raise Untranslatable
let add (ct1, l1: t) (ct2, l2: t) : t = let add (ct1, l1: t) (ct2, l2: t) : t =
......
...@@ -100,14 +100,13 @@ end ...@@ -100,14 +100,13 @@ end
let reduce_error cvalue error = let reduce_error cvalue error =
try try
let ival = Cvalue.V.project_ival cvalue in let ival = Cvalue.V.project_ival cvalue in
match ival with if Ival.is_float ival
| Ival.Float fval -> then
begin let fval = Ival.project_float ival in
match Numerors_value.reduce fval error with match Numerors_value.reduce fval error with
| `Value error -> cvalue, error | `Value error -> cvalue, error
| `Bottom -> cvalue, error (* TODO: we should be able to reduce to bottom. *) | `Bottom -> cvalue, error (* TODO: we should be able to reduce to bottom. *)
end else cvalue, error
| _ -> cvalue, error
with Cvalue.V.Not_based_on_null -> cvalue, error with Cvalue.V.Not_based_on_null -> cvalue, error
(* Reduction of the numerors value resulting from a cast from int to float type, (* Reduction of the numerors value resulting from a cast from int to float type,
......
...@@ -337,12 +337,12 @@ let reduce_apron_itv cvalue ival = ...@@ -337,12 +337,12 @@ let reduce_apron_itv cvalue ival =
| Some ival -> | Some ival ->
try try
let ival' = Cvalue.V.project_ival cvalue in let ival' = Cvalue.V.project_ival cvalue in
(match ival' with if Ival.is_int ival'
| Ival.Float _ -> raise Cvalue.V.Not_based_on_null then
| _ -> ()); let reduced_ival = Ival.narrow ival ival' in
let reduced_ival = Ival.narrow ival ival' in let cvalue = Cvalue.V.inject_ival reduced_ival in
let cvalue = Cvalue.V.inject_ival reduced_ival in cvalue, Some reduced_ival
cvalue, Some reduced_ival else cvalue, Some ival
with Cvalue.V.Not_based_on_null -> cvalue, Some ival with Cvalue.V.Not_based_on_null -> cvalue, Some ival
let () = let () =
......
...@@ -161,14 +161,17 @@ let make_loc_contiguous loc = ...@@ -161,14 +161,17 @@ let make_loc_contiguous loc =
let base, offset = let base, offset =
Locations.Location_Bits.find_lonely_key loc.Locations.loc Locations.Location_Bits.find_lonely_key loc.Locations.loc
in in
match offset, loc.Locations.size with if Ival.is_small_set offset
| Ival.Top (Some min, Some max, _rem, modu), Int_Base.Value size then loc
when Int.equal modu size -> else
let size' = Int.add (Int.sub max min) modu in let min, max, _rem, modu = Ival.min_max_r_mod offset in
let i = Ival.inject_singleton min in match min, max, loc.Locations.size with
let loc_bits = Locations.Location_Bits.inject base i in | Some min, Some max, Int_Base.Value size when Int.equal modu size ->
Locations.make_loc loc_bits (Int_Base.inject size') let size' = Int.add (Int.sub max min) modu in
| _ -> loc let i = Ival.inject_singleton min in
let loc_bits = Locations.Location_Bits.inject base i in
Locations.make_loc loc_bits (Int_Base.inject size')
| _ -> loc
with Not_found -> loc with Not_found -> loc
let apply_on_all_locs f loc state = let apply_on_all_locs f loc state =
......
...@@ -1145,7 +1145,7 @@ and eval_toffset ~alarm_mode env typ toffset = ...@@ -1145,7 +1145,7 @@ and eval_toffset ~alarm_mode env typ toffset =
(* Note: scale_int_base would overapproximate when given a (* Note: scale_int_base would overapproximate when given a
Float. Should never happen. *) Float. Should never happen. *)
| Int_Base.Value f -> | Int_Base.Value f ->
(match offset with | Ival.Float _ -> assert false | _ -> ()); assert (Ival.is_int offset);
Ival.scale f offset Ival.scale f offset
in in
Ival.add_int_under offset offsrem.eunder Ival.add_int_under offset offsrem.eunder
......
...@@ -52,18 +52,9 @@ let offsetmap_matches_type typ_lv o = ...@@ -52,18 +52,9 @@ let offsetmap_matches_type typ_lv o =
try typ_matches (V.project_ival_bottom v) try typ_matches (V.project_ival_bottom v)
with V.Not_based_on_null -> true (* Do not mess with pointers *) with V.Not_based_on_null -> true (* Do not mess with pointers *)
in in
let is_float = function
| Ival.Float _ -> true
| Ival.Top _ -> false
| Ival.Set _ as i -> Ival.(equal zero i || equal bottom i)
in
let is_int = function
| Ival.Top _ | Ival.Set _ -> true
| Ival.Float _ -> false
in
match Cil.unrollType typ_lv with match Cil.unrollType typ_lv with
| TFloat _ -> aux is_float | TFloat _ -> aux Ival.is_float
| TInt _ | TEnum _ | TPtr _ -> aux is_int | TInt _ | TEnum _ | TPtr _ -> aux Ival.is_int
| _ -> true | _ -> true
......
...@@ -173,8 +173,8 @@ module V = struct ...@@ -173,8 +173,8 @@ module V = struct
type. Find a matching offset with potentially the wrong type *) type. Find a matching offset with potentially the wrong type *)
find_match Bit_utils.MatchFirst, false find_match Bit_utils.MatchFirst, false
in in
match i with match Ival.project_small_set i with
| Ival.Set [|o|] -> | Some [o] ->
(* One single offset. Use a short notation, and an even shorter one (* One single offset. Use a short notation, and an even shorter one
if we represent [&b] *) if we represent [&b] *)
let o, ok = conv_offset o in let o, ok = conv_offset o in
...@@ -183,7 +183,7 @@ module V = struct ...@@ -183,7 +183,7 @@ module V = struct
else else
Format.fprintf fmt "@[%a%a%a@]" Format.fprintf fmt "@[%a%a%a@]"
pretty_cast ok Base.pretty_addr b Printer.pp_offset o pretty_cast ok Base.pretty_addr b Printer.pp_offset o
| Ival.Set a -> (* Multiple offsets. We use a set notation *) | Some a -> (* Multiple offsets. We use a set notation *)
(* Catch NoOffset, which we would be printed as '{, [1], [2]}. Instead, (* Catch NoOffset, which we would be printed as '{, [1], [2]}. Instead,
we find a slightly deeper offset. We should never be in a different we find a slightly deeper offset. We should never be in a different
case from array/comp, as the other types cannot have multiple case from array/comp, as the other types cannot have multiple
...@@ -199,7 +199,7 @@ module V = struct ...@@ -199,7 +199,7 @@ module V = struct
else o, ok else o, ok
in in
let arr_off, ok = let arr_off, ok =
Array.fold_right List.fold_right
(fun o (l, ok)-> let o', ok' = conv_offset' o in o' :: l, ok && ok') (fun o (l, ok)-> let o', ok' = conv_offset' o in o' :: l, ok && ok')
a ([], true) a ([], true)
in in
...@@ -208,10 +208,9 @@ module V = struct ...@@ -208,10 +208,9 @@ module V = struct
Base.pretty_addr b Base.pretty_addr b
(Pretty_utils.pp_iter (Pretty_utils.pp_iter
~sep:",@ " List.iter Printer.pp_offset) arr_off ~sep:",@ " List.iter Printer.pp_offset) arr_off
| Ival.Top _ -> | None ->
(* Too many offsets. Currently, we use the basic notation. *) (* Too many offsets. Currently, we use the basic notation. *)
pretty_base_offsets_default fmt b i pretty_base_offsets_default fmt b i
| Ival.Float _ -> assert false
with with
(* Strange looking base, or no offset found. Use default printing *) (* Strange looking base, or no offset found. Use default printing *)
| Base.Not_a_C_variable | Bit_utils.NoMatchingOffset -> | Base.Not_a_C_variable | Bit_utils.NoMatchingOffset ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment