From 1206f5ad8aa0e26ae7871bc03f67a8cdadccab0a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 16 Mar 2024 12:24:41 +0100 Subject: [PATCH 001/323] create template files for new weakly relational pointer analysis --- .../weaklyRelationalPointerAnalysis.ml | 40 ++++++++++++++++ src/cdomains/weaklyRelationalPointerDomain.ml | 47 +++++++++++++++++++ src/goblint_lib.ml | 2 + 3 files changed, 89 insertions(+) create mode 100644 src/analyses/weaklyRelationalPointerAnalysis.ml create mode 100644 src/cdomains/weaklyRelationalPointerDomain.ml diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml new file mode 100644 index 0000000000..0b435521d3 --- /dev/null +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -0,0 +1,40 @@ +(** A Weakly-Relational Pointer Analysis.. *) + +(** TODO description *) + +(* open Batteries + open GoblintCil + open Pretty *) +open Analyses +open WeaklyRelationalPointerDomain + +(* module M = Messages + module VS = SetDomain.Make (CilType.Varinfo) *) +module Spec : Spec = +struct + include DefaultSpec + module D = D + module C = D + + let name () = "weakly rlational pointer analysis" + + let startstate v = D.top() + + let exitstate v = D.top() + let assign ctx var expr = D.top() + let branch ctx expr neg = D.top() + + let body ctx f = D.top() + let return ctx exp_opt f = D.top() + + let special ctx var_opt v exprs = D.top() + + let enter ctx var_opt f exprs = [] + let combine_env ctx var_opt expr f exprs t_context_opt t ask = t + + let combine_assign ctx var_opt expr f exprs t_context_opt t ask = t + + let threadenter ctx ~multiple var_opt v exprs = [] + let threadspawn ctx ~multiple var_opt v exprs ctx2 = C.top() + +end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml new file mode 100644 index 0000000000..b6d592a202 --- /dev/null +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -0,0 +1,47 @@ +(** Domain for weakly relational pointer analysis. *) + +open Batteries +open GoblintCil + +module D :Lattice.S = struct + include Printable.StdLeaf + + type domain = {t: int } + type t = domain + + (** printing *) + let show x = "" + + include Printable.SimpleShow(struct type t = domain let show = show end) + + let name () = "weakly relational pointer analysis" + + (** let equal = Util.equals *) + let equal x y = true + + + (** compare all fields with correspoding compare operators *) + let compare x y = 0 + + + (** let hash = Hashtbl.hash *) + let hash x = 1 + let make tid pred ctx = tid + let bot () = {t = 0} + let is_bot x = true + let any_is_bot x = true + let top () = {t = 0} + let is_top x = false + + let leq x y = true + + let op_scheme op1 op2 op3 x y : t = {t = 0} + + let join a b = {t = 0} + let widen = join + let meet a b = {t = 0} + let narrow = meet + + let pretty_diff () (x,y) = Pretty.dprintf "" + +end diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index e06cc8fa08..762d7a08a7 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -90,6 +90,7 @@ module Malloc_null = Malloc_null module MemLeak = MemLeak module UseAfterFree = UseAfterFree module MemOutOfBounds = MemOutOfBounds +module WeaklyRelationalPointerAnalysis = WeaklyRelationalPointerAnalysis (** {2 Concurrency} @@ -216,6 +217,7 @@ module Mval = Mval module Offset = Offset module StringDomain = StringDomain module AddressDomain = AddressDomain +module WeaklyRelationalPointerDomain = WeaklyRelationalPointerDomain (** {5 Complex} *) From ccdebce77d24d3fecf6d014f5923ebf577e80cb2 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 18 Mar 2024 16:37:18 +0100 Subject: [PATCH 002/323] add code for congruence closure --- src/cdomains/congruenceClosure.ml | 329 ++++++++++++++++++++++++++++++ 1 file changed, 329 insertions(+) create mode 100644 src/cdomains/congruenceClosure.ml diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml new file mode 100644 index 0000000000..0b02a67576 --- /dev/null +++ b/src/cdomains/congruenceClosure.ml @@ -0,0 +1,329 @@ +(** OCaml implementation of a quantitative congruence closure. *) + +type 'v node = ('v * Z.t) ref * int +(* (value * offset) ref * size of equivalence class *) + +module type Val = sig + type t + val compare : t -> t -> int + val show : t -> string +end + +(** Quantitative union find *) +module UnionFind (Val: Val) = struct + module ValMap = Map.Make(Val) + module ZMap = Map.Make(Z) + module ValSet = Set.Make(Val) + + type t = Val.t node ValMap.t (* Union Find Map: maps value to a node type *) + + exception UnknownValue of Val.t + exception InvalidUnionFind of string + + (* create empty union find map *) + let init : Val.t list -> t = + List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) + + let is_root cc v = match ValMap.find_opt v cc with + | None -> raise (UnknownValue v) + | Some (refv, _) -> Val.compare v (fst !refv) = 0 + + (** + for a variable t it returns the reference variable v and the offset r + *) + let find cc v = match ValMap.find_opt v cc with + | None -> raise (UnknownValue v) + | Some (refv,_) -> let (v',r') = !refv in + if Val.compare v' v = 0 then + if Z.equal r' Z.zero then (v',r') + else raise (InvalidUnionFind "non-zero self-distance!") + else if is_root cc v' then + (* + let _ = print_string (Val.show v) in + let _ = print_string " = " in + let _ = print_string (string_of_int r') in + let _ = print_string "+" in + let _ = print_string (Val.show v') in + let _ = print_string "\n" in + *) + (v',r') + else + let rec search v list = match ValMap.find_opt v cc with + | None -> raise (UnknownValue v) + | Some (refv,_) -> let (v',r') = !refv in + if is_root cc v' then + let _ = List.fold_left (fun r0 refv -> + let (_,r'') = !refv in + let _ = refv := (v,Z.(r0+r'')) + in Z.(r0+r'')) r' list + in (v',r') + else search v' (refv :: list) + in + let v1,r = search v' [refv] in + (* + let _ = print_string (Val.show v) in + let _ = print_string " = " in + let _ = print_string (string_of_int r) in + let _ = print_string "+" in + let _ = print_string (Val.show v1) in + let _ = print_string "\n" in + *) + v1,r + + let union cc v'1 v'2 r = let v1,r1 = find cc v'1 in + let v2,r2 = find cc v'2 in + if Val.compare v1 v2 = 0 then + if r1 = Z.(r2 + r) then v1, cc, true + else raise (Failure "incomparable union") + else match ValMap.find_opt v1 cc, ValMap.find_opt v2 cc with + | Some (refv1,s1), + Some (refv2,s2) -> + if s1 <= s2 then ( + refv1 := (v2,Z.(r2-r1+r)); + v2, ValMap.add v2 (refv2,s1+s2) cc, false + ) else ( + refv2 := (v1,Z.(r1-r2-r)); + v1, ValMap.add v1 (refv1,s1+s2) cc, true + ) + | None, _ -> raise (UnknownValue v1) + | _, _ -> raise (UnknownValue v2) + + let clone map = + ValMap.bindings map |> + List.fold_left (fun map (v,node) -> ValMap.add v node map) (ValMap.empty) + + let map_find_opt (v,r) map = match ValMap.find_opt v map with + | None -> None + | Some zmap -> (match ZMap.find_opt r zmap with + | None -> None + | Some v -> Some v + ) + + let map_add (v,r) v' map = match ValMap.find_opt v map with + | None -> ValMap.add v (ZMap.add r v' ZMap.empty) map + | Some zmap -> ValMap.add v (ZMap.add r v' zmap) map + + let print_map map = + List.iter (fun (v,zmap) -> print_string (Val.show v); + print_string "\t:\n"; + List.iter (fun (r,v) -> + print_string "\t"; + Z.print r; + print_string ": "; + print_string (Val.show v); + print_string "; ") (ZMap.bindings zmap); + print_string "\n" + ) (ValMap.bindings map) +end + + +exception Unsat + +type 'v term = Addr of 'v | Deref of Z.t * 'v term +type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t + +module Term (Var:Val) = struct + type t = Var.t term + let compare = compare + let rec show = function + | Addr v -> "&" ^ Var.show v + | Deref (z, Addr v) when Z.equal z Z.zero -> Var.show v + | Deref (z, t) when Z.equal z Z.zero -> "*" ^ show t + | Deref (z, t) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" +end + + + +module CongruenceClosure (Var:Val) = struct + module T = Term (Var) + module TUF = UnionFind (T) (* union find on terms *) + module TSet = TUF.ValSet + module ZMap = TUF.ZMap + module TMap = TUF.ValMap + + type map_t = T.t ZMap.t TMap.t (* lookup map *) + type t = (TUF.t * map_t) + + let string_of_prop = function + | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 + | Eq (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 + | Neq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 + | Neq (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 + + let print_conj list = List.iter (fun d -> + print_string "\t"; + print_string (string_of_prop d); + print_string "\n") list + + let rec subterms_of_term (set,map) t = match t with + | Addr _ -> (TSet.add t set, map) + | Deref (z,t') -> + let set = TSet.add t set in + let map = TUF.map_add (t',z) t map in + (* let arg = TUF.map_set_add (t,z) t' arg in *) + subterms_of_term (set, map) t' + + let subterms_of_prop (set,map) = function + | Eq (t1,t2,_) + | Neq (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 + + let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty,TMap.empty) list + + (** + returns (part, set, map), where: + + part = empty union find structure where the elements are all subterms occuring in the conjunction + + set = set of all subterms occuring in the conjunction + + map = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t') + + *) + let init_cc conj = + let (set,map) = subterms_of_conj conj in + let part = TSet.elements set |> + TUF.init in + (part,set,map) + + let shift v r v' map = (* value at v' is shifted by r and then added for v *) + match TMap.find_opt v' map with + | None -> map + | Some zmap -> let infl = ZMap.bindings zmap in + let zmap = List.fold_left (fun zmap (r', v') -> + ZMap.add Z.(r' + r) v' zmap) ZMap.empty infl in + TMap.add v zmap map + + (** + parameters: (part, map) equalities + + returns updated (part, map), where: + + part is the new union find data structure after having added all equalities + + map maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z) + + *) + let rec closure (part,map) = function + (* should also operate on dmap *) + | [] -> (part,map) + | (t1,t2,r)::rest -> (match TUF.find part t1, TUF.find part t2 with + | (v1,r1), (v2,r2) -> + if T.compare v1 v2 = 0 then + (* t1 and t2 are in the same equivalence class *) + if r1 = Z.(r2+r) then closure (part,map) rest + else raise Unsat + else let v,part,b = TUF.union part v1 v2 Z.(r2-r1+r) in (* union *) + match TMap.find_opt v1 map, TMap.find_opt v2 map, b with + | None,_,false -> closure (part,map) rest + | None, Some _, true -> let map = shift v1 Z.(r1-r2-r) v2 map in + closure (part,map) rest + | Some _, None,false -> let map = shift v2 Z.(r2-r1+r) v1 map in + closure (part,map) rest + | _,None,true -> closure (part,map) rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in + let map = TMap.add v zmap map in + closure (part,map) rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2,rest) infl1 in + let map = TMap.add v zmap map in + closure (part,map) rest + ) + + let fold_left2 f acc l1 l2 = + List.fold_left ( + fun acc x -> List.fold_left ( + fun acc y -> f acc x y) acc l2) acc l1 + + let map2 f l1 l2 = List.concat ( + List.map (fun x -> + List.map (fun y -> f x y) l2) l1) + + let split conj = List.fold_left (fun (pos,neg) -> function + | Eq (t1,t2,r) -> ((t1,t2,r)::pos,neg) + | Neq(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj + + let congruence conj = + let part,set,map = init_cc conj in + let pos,_ = split conj in + (* propagating equalities through derefs *) + let part,map = closure (part,map) pos in + (part,set,map) + + let print_eq cmap = + let clist = TMap.bindings cmap in + List.iter (fun (v,zmap) -> + let ilist = ZMap.bindings zmap in + List.iter (fun (r,set) -> + let list = TSet.elements set in + List.iter (fun v' -> + if T.compare v v' = 0 then () else ( + print_string "\t"; + print_string (T.show v'); + print_string " = "; + (if Z.equal r Z.zero then () else + Z.print r; + print_string " + "); + print_string (T.show v); + print_string "\n")) list) ilist) clist + + (** Add a term to the data structure + + returns (reference variable, offset), updated (part, set, map)*) + let rec insert (part,set,map) t = + (* should also update dmap *) + if TSet.mem t set then + TUF.find part t, (part,set,map) + else let set = TSet.add t set in + match t with + | Addr _ -> let part = TMap.add t (ref (t,Z.zero),1) part in + (t, Z.zero), (part, set, map) + | Deref (z,t') -> + let (v,r), (part,set,map) = insert (part,set,map) t' in + match TUF.map_find_opt (v,Z.(r+z)) map with + | Some v' -> TUF.find part v', (part,set,map) + | None -> let map = TUF.map_add (v,Z.(r+z)) t map in + let part = TMap.add t (ref (t,Z.zero),1) part in + (t, Z.zero), (part, set, map) + + (** + returns true if t1 and t2 are equivalent + *) + let eq_query (part,set,map) (t1,t2,r) = + let (v1,r1),(part,set,map) = insert (part,set,map) t1 in + let (v2,r2),(part,set,map) = insert (part,set,map) t2 in + (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), (part, set, map)) + + (** + returns true if t1 and t2 are not equivalent + *) + let neq_query (part,set,map) conj (t1,t2,r) = + let (v1,r1),(part,set,map) = insert (part,set,map) t1 in + let (v2,r2),(part,set,map) = insert (part,set,map) t2 in + if T.compare v1 v2 = 0 then + if r1 = r2 then false + else true + else false (* TODO *) + + (** + add proposition t1 = t2 + r to the data structure + *) + let add_eq (part, set, map) (t1, t2, r) = + (* should use ineq. for refuting equality *) + let (v1, r1), (part, set, map) = insert (part, set, map) t1 in + let (v2, r2), (part, set, map) = insert (part, set, map) t2 in + let part, map = closure (part, map) [v1, v2, Z.(r2 - r1 + r)] in + part, set, map + +end From fdf6eab11d81b7ba076a44968781998ba114e332 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 19 Mar 2024 17:58:45 +0100 Subject: [PATCH 003/323] started implementing Quantitative finite automaton --- src/cdomains/congruenceClosure.ml | 72 +++++++++++++++++++++++++++---- 1 file changed, 63 insertions(+), 9 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 0b02a67576..6b41702076 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1,7 +1,9 @@ (** OCaml implementation of a quantitative congruence closure. *) +open Batteries + +(** (value * offset) ref * size of equivalence class *) type 'v node = ('v * Z.t) ref * int -(* (value * offset) ref * size of equivalence class *) module type Val = sig type t @@ -15,12 +17,12 @@ module UnionFind (Val: Val) = struct module ZMap = Map.Make(Z) module ValSet = Set.Make(Val) - type t = Val.t node ValMap.t (* Union Find Map: maps value to a node type *) + type t = Val.t node ValMap.t (** Union Find Map: maps value to a node type *) exception UnknownValue of Val.t exception InvalidUnionFind of string - (* create empty union find map *) + (** create empty union find map *) let init : Val.t list -> t = List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) @@ -29,7 +31,7 @@ module UnionFind (Val: Val) = struct | Some (refv, _) -> Val.compare v (fst !refv) = 0 (** - for a variable t it returns the reference variable v and the offset r + For a variable t it returns the reference variable v and the offset r *) let find cc v = match ValMap.find_opt v cc with | None -> raise (UnknownValue v) @@ -69,6 +71,10 @@ module UnionFind (Val: Val) = struct let _ = print_string "\n" in *) v1,r + let find_opt cc v = match find cc v with + | exception (UnknownValue _) + | exception (InvalidUnionFind _) -> None + | res -> Some res let union cc v'1 v'2 r = let v1,r1 = find cc v'1 in let v2,r2 = find cc v'2 in @@ -136,12 +142,12 @@ end module CongruenceClosure (Var:Val) = struct module T = Term (Var) - module TUF = UnionFind (T) (* union find on terms *) + module TUF = UnionFind (T) (** Union find on terms *) module TSet = TUF.ValSet module ZMap = TUF.ZMap module TMap = TUF.ValMap - type map_t = T.t ZMap.t TMap.t (* lookup map *) + type map_t = T.t ZMap.t TMap.t (** Lookup map *) type t = (TUF.t * map_t) let string_of_prop = function @@ -250,6 +256,8 @@ module CongruenceClosure (Var:Val) = struct List.map (fun x -> List.map (fun y -> f x y) l2) l1) + (** Splits the conjunction into two groups: the first one contains all equality propositions, + and the second one contains all inequality propositions. *) let split conj = List.fold_left (fun (pos,neg) -> function | Eq (t1,t2,r) -> ((t1,t2,r)::pos,neg) | Neq(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj @@ -298,7 +306,7 @@ module CongruenceClosure (Var:Val) = struct (t, Z.zero), (part, set, map) (** - returns true if t1 and t2 are equivalent + Returns true if t1 and t2 are equivalent *) let eq_query (part,set,map) (t1,t2,r) = let (v1,r1),(part,set,map) = insert (part,set,map) t1 in @@ -306,7 +314,7 @@ module CongruenceClosure (Var:Val) = struct (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), (part, set, map)) (** - returns true if t1 and t2 are not equivalent + Returns true if t1 and t2 are not equivalent *) let neq_query (part,set,map) conj (t1,t2,r) = let (v1,r1),(part,set,map) = insert (part,set,map) t1 in @@ -317,7 +325,7 @@ module CongruenceClosure (Var:Val) = struct else false (* TODO *) (** - add proposition t1 = t2 + r to the data structure + Add proposition t1 = t2 + r to the data structure *) let add_eq (part, set, map) (t1, t2, r) = (* should use ineq. for refuting equality *) @@ -327,3 +335,49 @@ module CongruenceClosure (Var:Val) = struct part, set, map end + + +module QFA (Var:Val) = +struct + module CC = CongruenceClosure(Var) + include CC + + type state = T.t (** The state is represented by the representative -> or by the minimal term. *) + + type initial_states = Var.t -> (state * Z.t) (** Maps each variable to its initial state. *) + + type transitions = Z.t -> state -> (Z.t * state) option + + type qfa = transitions + + (* let get_vars = List.filter_map (function + | Addr var -> Some var + | _ -> None) % TSet.elements *) + + (** Returns the initial state of the QFA for a certain variable + + Parameters: Union Find Map and variable for which we want to know the initial state *) + let get_initial_state part var = TUF.find_opt part (Addr var) + + (* pag. 8 before proposition 1 *) + (** Returns the transition of the QFA for a certain Z, starting from a certain state + + Parameters: + + - Lookup Map + + - Z and State for which we want to know the next state *) + let transition_qfa map z state = TUF.map_find_opt (state, z) map + + (* Question: is this not the same as find_opt?? *) + (** Returns the state we get from the automata after it has read the term + + Parameters: Union Find Map and term for which we want to know the final state *) + let rec get_state (part, map) = function + | Addr v -> get_initial_state part v + | Deref (z, t) -> match get_state (part, map) t with + | None -> None + | Some (next_state, z1) -> transition_qfa map (Z.(z + z1)) next_state + + +end From 3425be4b9f9eac25fcc3af60fb9e606126faa0ea Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 21 Mar 2024 15:22:25 +0100 Subject: [PATCH 004/323] implemented computing minimal representatives and the canonical normal form --- src/cdomains/congruenceClosure.ml | 351 ++++++++++++++++++++++-------- 1 file changed, 256 insertions(+), 95 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6b41702076..68a5f50705 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -76,6 +76,20 @@ module UnionFind (Val: Val) = struct | exception (InvalidUnionFind _) -> None | res -> Some res + (** + Parameters: part v1 v2 r + + chages the union find data structure `part` such that the equivalence classes of `v1` and `v2` are merged and `v1 = v2 + r` + + returns v,part,b where + + - `v` is the new reference variable of the merged equivalence class. It is either the old reference variable of v1 or of v2, depending on which equivalence class is bigger. + + - `part` is the new union find data structure + + - `b` is true iff v = find v1 + + *) let union cc v'1 v'2 r = let v1,r1 = find cc v'1 in let v2,r2 = find cc v'2 in if Val.compare v1 v2 = 0 then @@ -85,10 +99,10 @@ module UnionFind (Val: Val) = struct | Some (refv1,s1), Some (refv2,s2) -> if s1 <= s2 then ( - refv1 := (v2,Z.(r2-r1+r)); + refv1 := (v2, Z.(r2 - r1 + r)); v2, ValMap.add v2 (refv2,s1+s2) cc, false ) else ( - refv2 := (v1,Z.(r1-r2-r)); + refv2 := (v1, Z.(r1 - r2 - r)); v1, ValMap.add v1 (refv1,s1+s2) cc, true ) | None, _ -> raise (UnknownValue v1) @@ -122,10 +136,9 @@ module UnionFind (Val: Val) = struct ) (ValMap.bindings map) end - exception Unsat -type 'v term = Addr of 'v | Deref of Z.t * 'v term +type 'v term = Addr of 'v | Deref of 'v term * Z.t type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t module Term (Var:Val) = struct @@ -133,13 +146,11 @@ module Term (Var:Val) = struct let compare = compare let rec show = function | Addr v -> "&" ^ Var.show v - | Deref (z, Addr v) when Z.equal z Z.zero -> Var.show v - | Deref (z, t) when Z.equal z Z.zero -> "*" ^ show t - | Deref (z, t) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" + | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v + | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t + | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" end - - module CongruenceClosure (Var:Val) = struct module T = Term (Var) module TUF = UnionFind (T) (** Union find on terms *) @@ -147,8 +158,12 @@ module CongruenceClosure (Var:Val) = struct module ZMap = TUF.ZMap module TMap = TUF.ValMap + type part_t = TUF.t + type set_t = TSet type map_t = T.t ZMap.t TMap.t (** Lookup map *) - type t = (TUF.t * map_t) + type min_repr_t = (T.t * Z.t) TMap.t + + type t = (part_t * set_t * map_t * min_repr_t) let string_of_prop = function | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 @@ -163,7 +178,7 @@ module CongruenceClosure (Var:Val) = struct let rec subterms_of_term (set,map) t = match t with | Addr _ -> (TSet.add t set, map) - | Deref (z,t') -> + | Deref (t',z) -> let set = TSet.add t set in let map = TUF.map_add (t',z) t map in (* let arg = TUF.map_set_add (t,z) t' arg in *) @@ -175,78 +190,209 @@ module CongruenceClosure (Var:Val) = struct let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty,TMap.empty) list + let shift v r v' map = (* value at v' is shifted by r and then added for v *) + match TMap.find_opt v' map with + | None -> map + | Some zmap -> let infl = ZMap.bindings zmap in + let zmap = List.fold_left (fun zmap (r', v') -> + ZMap.add Z.(r' + r) v' zmap) ZMap.empty infl in + TMap.add v zmap map + + + let print_min_rep min_representatives = + let print_one_rep (state, (rep, z)) = + print_string "\tState rep: "; + print_string @@ T.show state; + print_string "\n\tMin. Representative: ("; + print_string @@ T.show rep; + print_string ", "; + Z.print z; + print_string ")\n\n" in + List.iter print_one_rep @@ TMap.bindings min_representatives + + + (** Uses dijkstra algorithm to update the minimal representatives of + all edges in the queue and if necessary also updates the minimal representatives of + the successor nodes of the automata + + parameters: + + `(part, map)` represent the union find data tructure and the corresponding lookup map + + `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class + + `queue` contains the states that need to be processed. + The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. + Therefore the queue is a list of representative terms. *) + let rec update_min_repr (part, map) min_representatives = function + | [] -> min_representatives + | state::queue -> (* process all outgoing edges in order of ascending edge labels *) + match ZMap.bindings (TMap.find state map) with + | exception Not_found -> (* no outgoing edges *) + update_min_repr (part, map) min_representatives queue + | edges -> + let process_edge (min_representatives, queue) (edge_z, next_term) = + let (next_state, next_z) = TUF.find part next_term in + let (min_term, min_z) = TMap.find state min_representatives in + let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in + match TMap.find_opt next_state min_representatives + with + | None -> + (TMap.add next_state next_min min_representatives, queue @ [next_state]) + | Some current_min when next_min < current_min -> + (TMap.add next_state next_min min_representatives, queue @ [next_state]) + | _ -> (min_representatives, queue) + in + let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges + in update_min_repr (part, map) min_representatives queue + + let get_atoms set = + (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, + according to our comparison function. Therefore take_while is enough.*) + BatList.take_while (function Addr _ -> true | _ -> false) (TSet.elements set) + + (** + Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. + I think it's not used for now, because we compute the minimal representatives incrementally. + *) + let compute_minimal_representatives (part, set, map) = + let atoms = get_atoms set in + (* process all atoms in increasing order *) + let atoms = + List.sort (fun el1 el2 -> compare (TUF.find part el1) (TUF.find part el2)) atoms in + let add_atom_to_map (min_representatives, queue) a = + let (rep, offs) = TUF.find part a in + if not (TMap.mem rep min_representatives) then + (TMap.add rep (a, offs) min_representatives, queue @ [rep]) + else (min_representatives, queue) + in + let (min_representatives, queue) = List.fold_left add_atom_to_map (TMap.empty, []) atoms + (* compute the minimal representative of all remaining edges *) + in update_min_repr (part, map) min_representatives queue + (** - returns (part, set, map), where: + Computes the initial map if minimal representatives. + It maps each element `e` in the set to `(e, 0)`. *) + let initial_minimal_representatives set = + List.fold_left (fun map element -> TMap.add element (element, Z.zero) map) TMap.empty (TSet.elements set) + + let get_transitions (part, map) = + List.flatten @@ List.map (fun (t, imap) -> List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ZMap.bindings imap) (TMap.bindings map) + + let get_normal_form (part, set, map, min_repr) = + let normalize_equality (t1, t2, z) = + if t1 = t2 && Z.(compare z zero) = 0 then None else + Some (Eq (t1, t2, z)) in + let conjunctions_of_atoms = + let atoms = get_atoms set in + List.filter_map (fun atom -> + let (rep_state, rep_z) = TUF.find part atom in + let (min_state, min_z) = TMap.find rep_state min_repr in + normalize_equality (atom, min_state, Z.(rep_z - min_z)) + ) atoms + in + let conjunctions_of_transitions = + let transitions = get_transitions (part, map) in + List.filter_map (fun (z,s,(s',z')) -> + let (min_state, min_z) = TMap.find s min_repr in + let (min_state', min_z') = TMap.find s' min_repr in + normalize_equality (Deref(min_state, Z.(z - min_z)), min_state', Z.(z' - min_z')) + ) transitions + in BatList.unique (conjunctions_of_atoms @ conjunctions_of_transitions) - part = empty union find structure where the elements are all subterms occuring in the conjunction + (** + returns (part, set, map, min_repr), where: + + - `part` = empty union find structure where the elements are all subterms occuring in the conjunction - set = set of all subterms occuring in the conjunction + - `set` = set of all subterms occuring in the conjunction - map = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t') + - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t') + - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class *) let init_cc conj = - let (set,map) = subterms_of_conj conj in + let (set, map) = subterms_of_conj conj in let part = TSet.elements set |> TUF.init in - (part,set,map) - - let shift v r v' map = (* value at v' is shifted by r and then added for v *) - match TMap.find_opt v' map with - | None -> map - | Some zmap -> let infl = ZMap.bindings zmap in - let zmap = List.fold_left (fun zmap (r', v') -> - ZMap.add Z.(r' + r) v' zmap) ZMap.empty infl in - TMap.add v zmap map + let min_repr = initial_minimal_representatives set in + print_endline "after init_cc the initial representatives are:"; + print_min_rep min_repr; + (part, set, map, min_repr) (** - parameters: (part, map) equalities + parameters: (part, map) equalities - returns updated (part, map), where: + returns updated (part, map, queue), where: - part is the new union find data structure after having added all equalities + part is the new union find data structure after having added all equalities - map maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z) + map maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z) + queue is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. + It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map *) - let rec closure (part,map) = function + let rec closure (part, map, min_repr) queue = function (* should also operate on dmap *) - | [] -> (part,map) - | (t1,t2,r)::rest -> (match TUF.find part t1, TUF.find part t2 with + | [] -> (part, map, queue, min_repr) + | (t1, t2, r)::rest -> (match TUF.find part t1, TUF.find part t2 with | (v1,r1), (v2,r2) -> if T.compare v1 v2 = 0 then (* t1 and t2 are in the same equivalence class *) - if r1 = Z.(r2+r) then closure (part,map) rest + if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest else raise Unsat - else let v,part,b = TUF.union part v1 v2 Z.(r2-r1+r) in (* union *) - match TMap.find_opt v1 map, TMap.find_opt v2 map, b with - | None,_,false -> closure (part,map) rest - | None, Some _, true -> let map = shift v1 Z.(r1-r2-r) v2 map in - closure (part,map) rest - | Some _, None,false -> let map = shift v2 Z.(r2-r1+r) v1 map in - closure (part,map) rest - | _,None,true -> closure (part,map) rest (* either v1 or v2 does not occur inside Deref *) - | Some imap1, Some imap2, true -> (* v1 is new root *) - (* zmap describes args of Deref *) - let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in - let map = TMap.add v zmap map in - closure (part,map) rest - | Some imap1, Some imap2, false -> (* v2 is new root *) - let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2,rest) infl1 in - let map = TMap.add v zmap map in - closure (part,map) rest + else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) + (* update map *) + let map, rest = match TMap.find_opt v1 map, TMap.find_opt v2 map, b with + | None, _, false -> map, rest + | None, Some _, true -> shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> shift v2 Z.(r2-r1+r) v1 map, rest + | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in + TMap.add v zmap map, rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in + TMap.add v zmap map, rest + in + (* update min_repr *) + let min_repr = + let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in + let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v1 in + TMap.add v (new_min, snd (TUF.find part new_min)) min_repr in + closure (part, map, min_repr) (v :: queue) rest ) + (** + Parameters: (part, map, min_repr) conjunctions + + returns updated (part, map, min_repr), where: + + - `part` is the new union find data structure after having added all equalities + + - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z) + + - `min_repr` maps each equivalence class to its minimal representative + + *) + let closure (part, set, map, min_repr) conjs = + let (part, map, queue, min_repr) = closure (part, map, min_repr) [] conjs in + (* sort queue by representative size *) + let queue = List.sort (fun el1 el2 -> let cmp_repr = compare (TUF.find part el1) (TUF.find part el2) in if cmp_repr = 0 then compare el1 el2 else cmp_repr) queue in + let min_repr = update_min_repr (part, map) min_repr queue in + (part, set, map, min_repr) + let fold_left2 f acc l1 l2 = List.fold_left ( fun acc x -> List.fold_left ( @@ -263,11 +409,10 @@ module CongruenceClosure (Var:Val) = struct | Neq(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj let congruence conj = - let part,set,map = init_cc conj in - let pos,_ = split conj in + let cc = init_cc conj in + let pos, _ = split conj in (* propagating equalities through derefs *) - let part,map = closure (part,map) pos in - (part,set,map) + closure cc pos let print_eq cmap = let clist = TMap.bindings cmap in @@ -288,51 +433,65 @@ module CongruenceClosure (Var:Val) = struct (** Add a term to the data structure - returns (reference variable, offset), updated (part, set, map)*) - let rec insert (part,set,map) t = + Returns (reference variable, offset), updated (part, set, map, min_repr), + and queue, that needs to be passed as a parameter to `update_min_repr`. + + `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. + Therefore it contains either one or zero elements. *) + let rec insert (part, set, map, min_repr) t = (* should also update dmap *) if TSet.mem t set then - TUF.find part t, (part,set,map) + TUF.find part t, (part, set, map, min_repr),[] else let set = TSet.add t set in match t with - | Addr _ -> let part = TMap.add t (ref (t,Z.zero),1) part in - (t, Z.zero), (part, set, map) - | Deref (z,t') -> - let (v,r), (part,set,map) = insert (part,set,map) t' in - match TUF.map_find_opt (v,Z.(r+z)) map with - | Some v' -> TUF.find part v', (part,set,map) - | None -> let map = TUF.map_add (v,Z.(r+z)) t map in + | Addr a -> let part = TMap.add t (ref (t, Z.zero),1) part in + let min_repr = TMap.add t (t, Z.zero) min_repr in + (t, Z.zero), (part, set, map, min_repr), [Addr a] + | Deref (t', z) -> + let (v, r), (part, set, map, min_repr), queue = insert (part, set, map, min_repr) t' in + match TUF.map_find_opt (v, Z.(r + z)) map with + | Some v' -> TUF.find part v', (part, set, map, min_repr), queue + | None -> let map = TUF.map_add (v,Z.(r + z)) t map in let part = TMap.add t (ref (t,Z.zero),1) part in - (t, Z.zero), (part, set, map) + (t, Z.zero), (part, set, map, min_repr), queue + + (** Add a term to the data structure + + Returns (reference variable, offset), updated (part, set, map, min_repr) *) + let insert (part, set, map, min_repr) t = + let v, (part, set, map, min_repr), queue = insert (part, set, map, min_repr) t in + (* the queue has at most one element, so there is no need to sort it *) + let min_repr = update_min_repr (part, map) min_repr queue in + v, (part, set, map, min_repr) (** Returns true if t1 and t2 are equivalent *) - let eq_query (part,set,map) (t1,t2,r) = - let (v1,r1),(part,set,map) = insert (part,set,map) t1 in - let (v2,r2),(part,set,map) = insert (part,set,map) t2 in - (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), (part, set, map)) + let eq_query cc (t1,t2,r) = + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), cc) (** Returns true if t1 and t2 are not equivalent *) - let neq_query (part,set,map) conj (t1,t2,r) = - let (v1,r1),(part,set,map) = insert (part,set,map) t1 in - let (v2,r2),(part,set,map) = insert (part,set,map) t2 in + let neq_query cc _ (t1,t2,_) = + let (v1,r1),cc = insert cc t1 in + let (v2,r2),_ = insert cc t2 in if T.compare v1 v2 = 0 then if r1 = r2 then false else true - else false (* TODO *) + else false (* TODO disequalities *) (** Add proposition t1 = t2 + r to the data structure *) - let add_eq (part, set, map) (t1, t2, r) = + let add_eq cc (t1, t2, r) = (* should use ineq. for refuting equality *) - let (v1, r1), (part, set, map) = insert (part, set, map) t1 in - let (v2, r2), (part, set, map) = insert (part, set, map) t2 in - let part, map = closure (part, map) [v1, v2, Z.(r2 - r1 + r)] in - part, set, map + let (v1, r1), cc = insert cc t1 in + let (v2, r2), cc = insert cc t2 in + let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in + cc end @@ -348,8 +507,6 @@ struct type transitions = Z.t -> state -> (Z.t * state) option - type qfa = transitions - (* let get_vars = List.filter_map (function | Addr var -> Some var | _ -> None) % TSet.elements *) @@ -367,17 +524,21 @@ struct - Lookup Map - Z and State for which we want to know the next state *) - let transition_qfa map z state = TUF.map_find_opt (state, z) map + let transition_qfa (part, map) z state = match TUF.map_find_opt (state, z) map with + | Some term -> TUF.find_opt part term + | None -> None - (* Question: is this not the same as find_opt?? *) - (** Returns the state we get from the automata after it has read the term + + (* Question: is this not the same as find_opt?? I think it is *) + (** Returns the state we get from the automata after it has read the term. + + It's useless. Parameters: Union Find Map and term for which we want to know the final state *) let rec get_state (part, map) = function | Addr v -> get_initial_state part v - | Deref (z, t) -> match get_state (part, map) t with + | Deref (t, z) -> match get_state (part, map) t with | None -> None | Some (next_state, z1) -> transition_qfa map (Z.(z + z1)) next_state - end From 3d5868f2bbe84c7e1b35782a5007a08d032c402a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 21 Mar 2024 19:11:08 +0100 Subject: [PATCH 005/323] changed domain type to record type instead of tuple and implemented some lattice functions --- src/cdomains/congruenceClosure.ml | 179 ++++++++++-------- src/cdomains/weaklyRelationalPointerDomain.ml | 56 ++++-- 2 files changed, 134 insertions(+), 101 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 68a5f50705..b76124cf76 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -2,22 +2,35 @@ open Batteries -(** (value * offset) ref * size of equivalence class *) -type 'v node = ('v * Z.t) ref * int - module type Val = sig type t val compare : t -> t -> int + val equal : t -> t -> bool val show : t -> string + val hash : t -> int end (** Quantitative union find *) module UnionFind (Val: Val) = struct - module ValMap = Map.Make(Val) - module ZMap = Map.Make(Z) - module ValSet = Set.Make(Val) - - type t = Val.t node ValMap.t (** Union Find Map: maps value to a node type *) + module ValMap = struct + include Map.Make(Val) + let hash x y = 3 + end + module ZMap = struct + include Map.Make(Z) + let hash x y = 3 + end + module ValSet = struct + include Set.Make(Val) + let hash x = 3 + end + + let hash_ref x y = 3 + + (** (value * offset) ref * size of equivalence class *) + type 'v node = ('v * Z.t) ref * int [@@deriving eq, ord, hash] + + type t = Val.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) exception UnknownValue of Val.t exception InvalidUnionFind of string @@ -30,6 +43,8 @@ module UnionFind (Val: Val) = struct | None -> raise (UnknownValue v) | Some (refv, _) -> Val.compare v (fst !refv) = 0 + let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst !refv) = 0) (ValMap.bindings uf) + (** For a variable t it returns the reference variable v and the offset r *) @@ -76,6 +91,8 @@ module UnionFind (Val: Val) = struct | exception (InvalidUnionFind _) -> None | res -> Some res + let repr_compare = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare + (** Parameters: part v1 v2 r @@ -122,27 +139,26 @@ module UnionFind (Val: Val) = struct let map_add (v,r) v' map = match ValMap.find_opt v map with | None -> ValMap.add v (ZMap.add r v' ZMap.empty) map | Some zmap -> ValMap.add v (ZMap.add r v' zmap) map - - let print_map map = - List.iter (fun (v,zmap) -> print_string (Val.show v); - print_string "\t:\n"; - List.iter (fun (r,v) -> - print_string "\t"; - Z.print r; - print_string ": "; - print_string (Val.show v); - print_string "; ") (ZMap.bindings zmap); - print_string "\n" - ) (ValMap.bindings map) + let show_map map = + List.fold_left + (fun s (v, zmap) -> + s ^ Val.show v ^ "\t:\n" ^ + List.fold_left + (fun s (r, v) -> + s ^ "\t" ^ Z.to_string r ^ ": " ^ Val.show v ^ "; ") + "" (ZMap.bindings zmap) ^ "\n") + "" (ValMap.bindings map) + + let print_map = print_string % show_map end exception Unsat -type 'v term = Addr of 'v | Deref of 'v term * Z.t -type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t +type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] +type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] module Term (Var:Val) = struct - type t = Var.t term + type t = Var.t term [@@deriving eq, ord, hash] let compare = compare let rec show = function | Addr v -> "&" ^ Var.show v @@ -151,6 +167,7 @@ module Term (Var:Val) = struct | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" end +(** Quantitative congruence closure *) module CongruenceClosure (Var:Val) = struct module T = Term (Var) module TUF = UnionFind (T) (** Union find on terms *) @@ -158,12 +175,16 @@ module CongruenceClosure (Var:Val) = struct module ZMap = TUF.ZMap module TMap = TUF.ValMap - type part_t = TUF.t - type set_t = TSet - type map_t = T.t ZMap.t TMap.t (** Lookup map *) - type min_repr_t = (T.t * Z.t) TMap.t + type part_t = TUF.t [@@deriving eq, ord, hash] + type set_t = TSet.t [@@deriving eq, ord, hash] + type map_t = T.t ZMap.t TMap.t [@@deriving eq, ord, hash] (** Lookup map *) + type min_repr_t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] - type t = (part_t * set_t * map_t * min_repr_t) + type t = {part: part_t; + set: set_t; + map: map_t; + min_repr: min_repr_t} + [@@deriving eq, ord, hash] let string_of_prop = function | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 @@ -171,10 +192,11 @@ module CongruenceClosure (Var:Val) = struct | Neq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 | Neq (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 - let print_conj list = List.iter (fun d -> - print_string "\t"; - print_string (string_of_prop d); - print_string "\n") list + + let show_conj list = List.fold_left + (fun s d -> s ^ "\t" ^ string_of_prop d ^ "\n") "" list + + let print_conj = print_string % show_conj let rec subterms_of_term (set,map) t = match t with | Addr _ -> (TSet.add t set, map) @@ -199,16 +221,14 @@ module CongruenceClosure (Var:Val) = struct TMap.add v zmap map - let print_min_rep min_representatives = - let print_one_rep (state, (rep, z)) = - print_string "\tState rep: "; - print_string @@ T.show state; - print_string "\n\tMin. Representative: ("; - print_string @@ T.show rep; - print_string ", "; - Z.print z; - print_string ")\n\n" in - List.iter print_one_rep @@ TMap.bindings min_representatives + let show_min_rep min_representatives = + let show_one_rep s (state, (rep, z)) = + s ^ "\tState rep: " ^ T.show state ^ + "\n\tMin. Representative: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")\n\n" + in + List.fold_left show_one_rep "" (TMap.bindings min_representatives) + + let print_min_rep = print_string % show_min_rep (** Uses dijkstra algorithm to update the minimal representatives of @@ -259,7 +279,7 @@ module CongruenceClosure (Var:Val) = struct let atoms = get_atoms set in (* process all atoms in increasing order *) let atoms = - List.sort (fun el1 el2 -> compare (TUF.find part el1) (TUF.find part el2)) atoms in + List.sort (fun el1 el2 -> TUF.repr_compare (TUF.find part el1) (TUF.find part el2)) atoms in let add_atom_to_map (min_representatives, queue) a = let (rep, offs) = TUF.find part a in if not (TMap.mem rep min_representatives) then @@ -277,31 +297,32 @@ module CongruenceClosure (Var:Val) = struct List.fold_left (fun map element -> TMap.add element (element, Z.zero) map) TMap.empty (TSet.elements set) let get_transitions (part, map) = - List.flatten @@ List.map (fun (t, imap) -> List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ZMap.bindings imap) (TMap.bindings map) + List.flatten @@ List.map (fun (t, imap) -> List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ ZMap.bindings imap) (TMap.bindings map) - let get_normal_form (part, set, map, min_repr) = + (* Runtime = O(nrr. of atoms) + O(nr. transitions in the automata) *) + let get_normal_form cc = let normalize_equality (t1, t2, z) = if t1 = t2 && Z.(compare z zero) = 0 then None else Some (Eq (t1, t2, z)) in let conjunctions_of_atoms = - let atoms = get_atoms set in + let atoms = get_atoms cc.set in List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find part atom in - let (min_state, min_z) = TMap.find rep_state min_repr in + let (rep_state, rep_z) = TUF.find cc.part atom in + let (min_state, min_z) = TMap.find rep_state cc.min_repr in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms in let conjunctions_of_transitions = - let transitions = get_transitions (part, map) in + let transitions = get_transitions (cc.part, cc.map) in List.filter_map (fun (z,s,(s',z')) -> - let (min_state, min_z) = TMap.find s min_repr in - let (min_state', min_z') = TMap.find s' min_repr in + let (min_state, min_z) = TMap.find s cc.min_repr in + let (min_state', min_z') = TMap.find s' cc.min_repr in normalize_equality (Deref(min_state, Z.(z - min_z)), min_state', Z.(z' - min_z')) ) transitions - in BatList.unique (conjunctions_of_atoms @ conjunctions_of_transitions) + in BatList.sort_unique (compare_prop Var.compare) (conjunctions_of_atoms @ conjunctions_of_transitions) (** - returns (part, set, map, min_repr), where: + returns {part, set, map, min_repr}, where: - `part` = empty union find structure where the elements are all subterms occuring in the conjunction @@ -316,9 +337,7 @@ module CongruenceClosure (Var:Val) = struct let part = TSet.elements set |> TUF.init in let min_repr = initial_minimal_representatives set in - print_endline "after init_cc the initial representatives are:"; - print_min_rep min_repr; - (part, set, map, min_repr) + {part = part; set = set; map = map; min_repr = min_repr} (** parameters: (part, map) equalities @@ -333,7 +352,6 @@ module CongruenceClosure (Var:Val) = struct It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map *) let rec closure (part, map, min_repr) queue = function - (* should also operate on dmap *) | [] -> (part, map, queue, min_repr) | (t1, t2, r)::rest -> (match TUF.find part t1, TUF.find part t2 with | (v1,r1), (v2,r2) -> @@ -386,12 +404,12 @@ module CongruenceClosure (Var:Val) = struct - `min_repr` maps each equivalence class to its minimal representative *) - let closure (part, set, map, min_repr) conjs = - let (part, map, queue, min_repr) = closure (part, map, min_repr) [] conjs in + let closure cc conjs = + let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in (* sort queue by representative size *) - let queue = List.sort (fun el1 el2 -> let cmp_repr = compare (TUF.find part el1) (TUF.find part el2) in if cmp_repr = 0 then compare el1 el2 else cmp_repr) queue in + let queue = List.sort (fun el1 el2 -> let cmp_repr = TUF.repr_compare (TUF.find part el1) (TUF.find part el2) in if cmp_repr = 0 then compare_term Var.compare el1 el2 else cmp_repr) queue in let min_repr = update_min_repr (part, map) min_repr queue in - (part, set, map, min_repr) + (part, cc.set, map, min_repr) let fold_left2 f acc l1 l2 = List.fold_left ( @@ -438,31 +456,32 @@ module CongruenceClosure (Var:Val) = struct `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. Therefore it contains either one or zero elements. *) - let rec insert (part, set, map, min_repr) t = - (* should also update dmap *) - if TSet.mem t set then - TUF.find part t, (part, set, map, min_repr),[] - else let set = TSet.add t set in + let rec insert cc t = + if TSet.mem t cc.set then + TUF.find cc.part t, cc,[] + else let set = TSet.add t cc.set in match t with - | Addr a -> let part = TMap.add t (ref (t, Z.zero),1) part in - let min_repr = TMap.add t (t, Z.zero) min_repr in - (t, Z.zero), (part, set, map, min_repr), [Addr a] + | Addr a -> let part = TMap.add t (ref (t, Z.zero),1) cc.part in + let min_repr = TMap.add t (t, Z.zero) cc.min_repr in + (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> - let (v, r), (part, set, map, min_repr), queue = insert (part, set, map, min_repr) t' in - match TUF.map_find_opt (v, Z.(r + z)) map with - | Some v' -> TUF.find part v', (part, set, map, min_repr), queue - | None -> let map = TUF.map_add (v,Z.(r + z)) t map in - let part = TMap.add t (ref (t,Z.zero),1) part in - (t, Z.zero), (part, set, map, min_repr), queue + let (v, r), cc, queue = insert cc t' in + match TUF.map_find_opt (v, Z.(r + z)) cc.map with + | Some v' -> TUF.find cc.part v', cc, queue + (* TODO don't we need a union here? *) + | None -> let map = TUF.map_add (v, Z.(r + z)) t cc.map in + let part = TMap.add t (ref (t, Z.zero),1) cc.part in + let min_repr = TMap.add t (t, Z.zero) cc.min_repr in + (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, queue (** Add a term to the data structure Returns (reference variable, offset), updated (part, set, map, min_repr) *) - let insert (part, set, map, min_repr) t = - let v, (part, set, map, min_repr), queue = insert (part, set, map, min_repr) t in + let insert cc t = + let v, cc, queue = insert cc t in (* the queue has at most one element, so there is no need to sort it *) - let min_repr = update_min_repr (part, map) min_repr queue in - v, (part, set, map, min_repr) + let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in + v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} (** Returns true if t1 and t2 are equivalent @@ -532,7 +551,7 @@ struct (* Question: is this not the same as find_opt?? I think it is *) (** Returns the state we get from the automata after it has read the term. - It's useless. + It's useless. It's the same as TUF.find_opt. But less efficient. Parameters: Union Find Map and term for which we want to know the final state *) let rec get_state (part, map) = function diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index b6d592a202..3fe36b8fbc 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -2,44 +2,58 @@ open Batteries open GoblintCil +open CongruenceClosure + +module Var: Val = struct + type t = varinfo + let compare = compare (* TODO *) + let show v = v.vname (* TODO *) + let hash x = 3 (* TODO *) + let equal x y = (x = y) (* TODO *) +end + +module D : Lattice.S = struct -module D :Lattice.S = struct include Printable.StdLeaf + include CongruenceClosure(Var) - type domain = {t: int } + type domain = t option type t = domain - (** printing *) - let show x = "" + (** Convert to string *) + let show x = match x with + | None -> "⊥" + | Some x -> show_conj (get_normal_form x) - include Printable.SimpleShow(struct type t = domain let show = show end) + include Printable.SimpleShow(struct type t = domain let show = show end) - let name () = "weakly relational pointer analysis" + let name () = "wrpointer" - (** let equal = Util.equals *) - let equal x y = true + let equal x y = match x, y with + | Some x, Some y -> + (get_normal_form x = get_normal_form y) + | None, None -> true + | _ -> false + let compare x y = 0 (* How to compare if there is no total order? *) - (** compare all fields with correspoding compare operators *) - let compare x y = 0 + let empty () = Some {part = TMap.empty; set = TSet.empty; map = TMap.empty; min_repr = TMap.empty} + let init () = congruence [] (** let hash = Hashtbl.hash *) - let hash x = 1 - let make tid pred ctx = tid - let bot () = {t = 0} - let is_bot x = true - let any_is_bot x = true - let top () = {t = 0} - let is_top x = false + let hash x = 1 (* TODO *) + let bot () = None + let is_bot x = x = None + let top () = empty () + let is_top = function None -> false + | Some cc -> TUF.is_empty cc.part let leq x y = true - let op_scheme op1 op2 op3 x y : t = {t = 0} - - let join a b = {t = 0} + let join a b = a let widen = join - let meet a b = {t = 0} + let meet a b = a let narrow = meet let pretty_diff () (x,y) = Pretty.dprintf "" From 1061167df4e31d185ac5cb3798e23fd1fef042f4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 22 Mar 2024 10:33:17 +0100 Subject: [PATCH 006/323] added some show functions --- src/cdomains/congruenceClosure.ml | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b76124cf76..2b44649b02 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -91,7 +91,9 @@ module UnionFind (Val: Val) = struct | exception (InvalidUnionFind _) -> None | res -> Some res - let repr_compare = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare + let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare + + let compare_repr_v (v1, _) (v2, _)= Val.compare v1 v2 (** Parameters: part v1 v2 r @@ -125,6 +127,13 @@ module UnionFind (Val: Val) = struct | None, _ -> raise (UnknownValue v1) | _, _ -> raise (UnknownValue v2) + let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find uf el1) (find uf el2)) (ValMap.bindings uf) + + let show_uf uf = List.fold_left (fun s eq_class -> + s ^ List.fold_left (fun s (v, _) -> + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "\n") "" eq_class + ^ "\n") "" (get_eq_classes uf) ^ "\n" + let clone map = ValMap.bindings map |> List.fold_left (fun map (v,node) -> ValMap.add v node map) (ValMap.empty) @@ -139,6 +148,7 @@ module UnionFind (Val: Val) = struct let map_add (v,r) v' map = match ValMap.find_opt v map with | None -> ValMap.add v (ZMap.add r v' ZMap.empty) map | Some zmap -> ValMap.add v (ZMap.add r v' zmap) map + let show_map map = List.fold_left (fun s (v, zmap) -> @@ -150,6 +160,9 @@ module UnionFind (Val: Val) = struct "" (ValMap.bindings map) let print_map = print_string % show_map + + let show_set set = ValSet.fold (fun v s -> + s ^ "\t" ^ Val.show v ^ "\n") set "" ^ "\n" end exception Unsat @@ -159,7 +172,7 @@ type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@ module Term (Var:Val) = struct type t = Var.t term [@@deriving eq, ord, hash] - let compare = compare + let rec show = function | Addr v -> "&" ^ Var.show v | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v @@ -279,7 +292,7 @@ module CongruenceClosure (Var:Val) = struct let atoms = get_atoms set in (* process all atoms in increasing order *) let atoms = - List.sort (fun el1 el2 -> TUF.repr_compare (TUF.find part el1) (TUF.find part el2)) atoms in + List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find part el1) (TUF.find part el2)) atoms in let add_atom_to_map (min_representatives, queue) a = let (rep, offs) = TUF.find part a in if not (TMap.mem rep min_representatives) then @@ -407,9 +420,9 @@ module CongruenceClosure (Var:Val) = struct let closure cc conjs = let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in (* sort queue by representative size *) - let queue = List.sort (fun el1 el2 -> let cmp_repr = TUF.repr_compare (TUF.find part el1) (TUF.find part el2) in if cmp_repr = 0 then compare_term Var.compare el1 el2 else cmp_repr) queue in + let queue = List.sort (fun el1 el2 -> let cmp_repr = TUF.compare_repr (TUF.find part el1) (TUF.find part el2) in if cmp_repr = 0 then compare_term Var.compare el1 el2 else cmp_repr) queue in let min_repr = update_min_repr (part, map) min_repr queue in - (part, cc.set, map, min_repr) + {part = part;set = cc.set; map = map;min_repr = min_repr} let fold_left2 f acc l1 l2 = List.fold_left ( From a092e0e3e168c0ce09fb5d81c14fb0f5d108ad3c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 22 Mar 2024 11:08:47 +0100 Subject: [PATCH 007/323] added some comments --- src/cdomains/congruenceClosure.ml | 15 +++++++++++++-- src/cdomains/weaklyRelationalPointerDomain.ml | 12 ++++++++++-- 2 files changed, 23 insertions(+), 4 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2b44649b02..2067351724 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -39,14 +39,21 @@ module UnionFind (Val: Val) = struct let init : Val.t list -> t = List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) + (** Returns true if v is the representative value of its equivalence class + + Throws "Unknown value" if v is not present in the data structure. *) let is_root cc v = match ValMap.find_opt v cc with | None -> raise (UnknownValue v) | Some (refv, _) -> Val.compare v (fst !refv) = 0 + (** Returns true if each equivalence class in the data structure contains only one element, + i.e. every node is a root. *) let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst !refv) = 0) (ValMap.bindings uf) (** - For a variable t it returns the reference variable v and the offset r + For a variable t it returns the reference variable v and the offset r. + + Throws "Unknown value" if t is not present in the data structure. *) let find cc v = match ValMap.find_opt v cc with | None -> raise (UnknownValue v) @@ -129,6 +136,7 @@ module UnionFind (Val: Val) = struct let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find uf el1) (find uf el2)) (ValMap.bindings uf) + (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> s ^ List.fold_left (fun s (v, _) -> s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "\n") "" eq_class @@ -172,6 +180,7 @@ type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@ module Term (Var:Val) = struct type t = Var.t term [@@deriving eq, ord, hash] + type v_prop = Var.t prop [@@deriving eq, ord, hash] let rec show = function | Addr v -> "&" ^ Var.show v @@ -362,7 +371,9 @@ module CongruenceClosure (Var:Val) = struct map maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z) queue is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. - It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map + It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map. + + Throws "Unsat" if a contradiction is found. *) let rec closure (part, map, min_repr) queue = function | [] -> (part, map, queue, min_repr) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 3fe36b8fbc..2ccb833518 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -49,11 +49,19 @@ module D : Lattice.S = struct let is_top = function None -> false | Some cc -> TUF.is_empty cc.part - let leq x y = true + let leq x y = false let join a b = a let widen = join - let meet a b = a + let meet a b = match a,b with (*TODO merge environments *) + | None, b -> b + | a, None -> a + | Some a, Some b -> + let a_conj = get_normal_form a in + match (closure b (fst (split a_conj))) with + | res -> Some res + | exception Unsat -> None + let narrow = meet let pretty_diff () (x,y) = Pretty.dprintf "" From b711e7f17e3535dde66ece9a4e7820824365ad6a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 26 Mar 2024 14:34:24 +0100 Subject: [PATCH 008/323] implemented meet and fixed some problems in computing the minimal representatives --- src/cdomains/congruenceClosure.ml | 84 ++++++++++++------- src/cdomains/weaklyRelationalPointerDomain.ml | 21 ++++- 2 files changed, 74 insertions(+), 31 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2067351724..6e8956ee4f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -39,7 +39,7 @@ module UnionFind (Val: Val) = struct let init : Val.t list -> t = List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) - (** Returns true if v is the representative value of its equivalence class + (** Returns true if v is the representative value of its equivalence class Throws "Unknown value" if v is not present in the data structure. *) let is_root cc v = match ValMap.find_opt v cc with @@ -252,20 +252,6 @@ module CongruenceClosure (Var:Val) = struct let print_min_rep = print_string % show_min_rep - - (** Uses dijkstra algorithm to update the minimal representatives of - all edges in the queue and if necessary also updates the minimal representatives of - the successor nodes of the automata - - parameters: - - `(part, map)` represent the union find data tructure and the corresponding lookup map - - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class - - `queue` contains the states that need to be processed. - The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. - Therefore the queue is a list of representative terms. *) let rec update_min_repr (part, map) min_representatives = function | [] -> min_representatives | state::queue -> (* process all outgoing edges in order of ascending edge labels *) @@ -281,13 +267,35 @@ module CongruenceClosure (Var:Val) = struct with | None -> (TMap.add next_state next_min min_representatives, queue @ [next_state]) - | Some current_min when next_min < current_min -> - (TMap.add next_state next_min min_representatives, queue @ [next_state]) + (* | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> + (TMap.add next_state next_min min_representatives, queue @ [next_state])*) | _ -> (min_representatives, queue) in let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges in update_min_repr (part, map) min_representatives queue + (** Uses dijkstra algorithm to update the minimal representatives of + all edges in the queue and if necessary also updates the minimal representatives of + the successor nodes of the automata. + The states in the queu must already have an updated min_repr. + This function visits only the successor nodes of the nodes in queue, not the nodes themselves. + Before visiting the nodes, it sorts the queue by the size of the current min representative. + + parameters: + + `(part, map)` represent the union find data tructure and the corresponding lookup map + + `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class + + `queue` contains the states that need to be processed. + The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. + Therefore the queue is a list of representative terms. *) + let update_min_repr (part, map) min_representatives queue = + (* order queue by size of the current min representative *) + let queue = + List.sort (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue + in update_min_repr (part, map) min_representatives queue + let get_atoms set = (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, according to our comparison function. Therefore take_while is enough.*) @@ -313,13 +321,13 @@ module CongruenceClosure (Var:Val) = struct in update_min_repr (part, map) min_representatives queue (** - Computes the initial map if minimal representatives. + Computes the initial map of minimal representatives. It maps each element `e` in the set to `(e, 0)`. *) let initial_minimal_representatives set = - List.fold_left (fun map element -> TMap.add element (element, Z.zero) map) TMap.empty (TSet.elements set) + List.fold_left (fun map element -> TMap.add element (element, Z.zero) map) TMap.empty (TSet.elements set) let get_transitions (part, map) = - List.flatten @@ List.map (fun (t, imap) -> List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ ZMap.bindings imap) (TMap.bindings map) + List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ ZMap.bindings imap) else None) (TMap.bindings map) (* Runtime = O(nrr. of atoms) + O(nr. transitions in the automata) *) let get_normal_form cc = @@ -359,7 +367,7 @@ module CongruenceClosure (Var:Val) = struct let part = TSet.elements set |> TUF.init in let min_repr = initial_minimal_representatives set in - {part = part; set = set; map = map; min_repr = min_repr} + {part = part; set = set; map = map ; min_repr = min_repr} (** parameters: (part, map) equalities @@ -411,7 +419,7 @@ module CongruenceClosure (Var:Val) = struct (* update min_repr *) let min_repr = let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in - let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v1 in + let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v2 in TMap.add v (new_min, snd (TUF.find part new_min)) min_repr in closure (part, map, min_repr) (v :: queue) rest ) @@ -430,10 +438,8 @@ module CongruenceClosure (Var:Val) = struct *) let closure cc conjs = let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in - (* sort queue by representative size *) - let queue = List.sort (fun el1 el2 -> let cmp_repr = TUF.compare_repr (TUF.find part el1) (TUF.find part el2) in if cmp_repr = 0 then compare_term Var.compare el1 el2 else cmp_repr) queue in let min_repr = update_min_repr (part, map) min_repr queue in - {part = part;set = cc.set; map = map;min_repr = min_repr} + {part = part; set = cc.set; map = map; min_repr = min_repr} let fold_left2 f acc l1 l2 = List.fold_left ( @@ -450,12 +456,24 @@ module CongruenceClosure (Var:Val) = struct | Eq (t1,t2,r) -> ((t1,t2,r)::pos,neg) | Neq(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj + (** + Throws Unsat if the congruence is unsatisfiable.*) let congruence conj = let cc = init_cc conj in let pos, _ = split conj in (* propagating equalities through derefs *) closure cc pos + (** + Returns None if the congruence is unsatisfiable.*) + let congruence_opt conj = + let cc = init_cc conj in + let pos, _ = split conj in + (* propagating equalities through derefs *) + match closure cc pos with + | exception Unsat -> None + | x -> Some x + let print_eq cmap = let clist = TMap.bindings cmap in List.iter (fun (v,zmap) -> @@ -480,7 +498,7 @@ module CongruenceClosure (Var:Val) = struct `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. Therefore it contains either one or zero elements. *) - let rec insert cc t = + let rec insert_no_min_repr cc t = if TSet.mem t cc.set then TUF.find cc.part t, cc,[] else let set = TSet.add t cc.set in @@ -489,7 +507,7 @@ module CongruenceClosure (Var:Val) = struct let min_repr = TMap.add t (t, Z.zero) cc.min_repr in (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> - let (v, r), cc, queue = insert cc t' in + let (v, r), cc, queue = insert_no_min_repr cc t' in match TUF.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> TUF.find cc.part v', cc, queue (* TODO don't we need a union here? *) @@ -502,11 +520,21 @@ module CongruenceClosure (Var:Val) = struct Returns (reference variable, offset), updated (part, set, map, min_repr) *) let insert cc t = - let v, cc, queue = insert cc t in + let v, cc, queue = insert_no_min_repr cc t in (* the queue has at most one element, so there is no need to sort it *) let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} + (** Add all terms in a specific set to the data structure + + Returns updated (part, set, map, min_repr) *) + let insert_set cc t_set = TSet.fold (fun t cc -> snd (insert cc t)) t_set cc + (*let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in + let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in + + {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr}*) + + (** Returns true if t1 and t2 are equivalent *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 2ccb833518..fa46799ad6 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -25,6 +25,18 @@ module D : Lattice.S = struct | None -> "⊥" | Some x -> show_conj (get_normal_form x) + + let show_all = function + | None -> "⊥\n" + | Some x -> "Union Find partition:\n" ^ + (TUF.show_uf x.part) + ^ "\nSubterm set:\n" + ^ (TUF.show_set x.set) + ^ "\nLookup map/transitions:\n" + ^ (TUF.show_map x.map) + ^ "\nMinimal representatives:\n" + ^ (show_min_rep x.min_repr) + include Printable.SimpleShow(struct type t = domain let show = show end) let name () = "wrpointer" @@ -53,15 +65,18 @@ module D : Lattice.S = struct let join a b = a let widen = join - let meet a b = match a,b with (*TODO merge environments *) - | None, b -> b - | a, None -> a + + let meet a b = match a,b with(*TODO put in different file *) + | None, _ -> None + | _, None -> None | Some a, Some b -> let a_conj = get_normal_form a in + let b = insert_set b (fst (subterms_of_conj a_conj)) in match (closure b (fst (split a_conj))) with | res -> Some res | exception Unsat -> None + let narrow = meet let pretty_diff () (x,y) = Pretty.dprintf "" From 3f00c1154d0baa0105be878a2a7b199bfd812c66 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 26 Mar 2024 14:40:47 +0100 Subject: [PATCH 009/323] optimization of insert_set --- src/cdomains/congruenceClosure.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6e8956ee4f..1828a44789 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -528,11 +528,11 @@ module CongruenceClosure (Var:Val) = struct (** Add all terms in a specific set to the data structure Returns updated (part, set, map, min_repr) *) - let insert_set cc t_set = TSet.fold (fun t cc -> snd (insert cc t)) t_set cc - (*let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in + let insert_set cc t_set = (* SAFE VERSION but less efficient: TSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) + let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in + (* update min_repr at the end for more efficiency *) let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in - - {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr}*) + {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} (** From 285e41538725165b55c349e1a48992b7062c0c80 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 26 Mar 2024 15:31:15 +0100 Subject: [PATCH 010/323] clean up code for meet --- src/cdomains/congruenceClosure.ml | 11 +++++++++-- src/cdomains/weaklyRelationalPointerDomain.ml | 7 +++---- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 1828a44789..afc848caf9 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -458,7 +458,7 @@ module CongruenceClosure (Var:Val) = struct (** Throws Unsat if the congruence is unsatisfiable.*) - let congruence conj = + let init_congruence conj = let cc = init_cc conj in let pos, _ = split conj in (* propagating equalities through derefs *) @@ -466,7 +466,7 @@ module CongruenceClosure (Var:Val) = struct (** Returns None if the congruence is unsatisfiable.*) - let congruence_opt conj = + let init_congruence_opt conj = let cc = init_cc conj in let pos, _ = split conj in (* propagating equalities through derefs *) @@ -535,6 +535,13 @@ module CongruenceClosure (Var:Val) = struct {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} + (** + Throws "Unsat" if a contradiction is found. + *) + let meet_conjs cc conjs = + let cc = insert_set cc (fst (subterms_of_conj conjs)) in + closure cc (fst (split conjs)) + (** Returns true if t1 and t2 are equivalent *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index fa46799ad6..dd05936b65 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -51,7 +51,7 @@ module D : Lattice.S = struct let empty () = Some {part = TMap.empty; set = TSet.empty; map = TMap.empty; min_repr = TMap.empty} - let init () = congruence [] + let init () = init_congruence [] (** let hash = Hashtbl.hash *) let hash x = 1 (* TODO *) @@ -66,13 +66,12 @@ module D : Lattice.S = struct let join a b = a let widen = join - let meet a b = match a,b with(*TODO put in different file *) + let meet a b = match a,b with (*TODO put in different file *) | None, _ -> None | _, None -> None | Some a, Some b -> let a_conj = get_normal_form a in - let b = insert_set b (fst (subterms_of_conj a_conj)) in - match (closure b (fst (split a_conj))) with + match meet_conjs b a_conj with | res -> Some res | exception Unsat -> None From e8d5456365e3b43fb03747216cb531b8956cebe3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 27 Mar 2024 14:37:40 +0100 Subject: [PATCH 011/323] started implementing a map htat maps nodes to their children --- src/cdomains/congruenceClosure.ml | 248 +++++++++++++++++------------- 1 file changed, 145 insertions(+), 103 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index afc848caf9..f5c5e0629f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -30,19 +30,23 @@ module UnionFind (Val: Val) = struct (** (value * offset) ref * size of equivalence class *) type 'v node = ('v * Z.t) ref * int [@@deriving eq, ord, hash] + type children = ValSet.t ValMap.t [@@deriving eq, ord, hash] + (** Maps each value to its children in the union find data structure. + Necessary in order to be able to delete values. *) type t = Val.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) exception UnknownValue of Val.t exception InvalidUnionFind of string (** create empty union find map *) - let init : Val.t list -> t = - List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) + let init : Val.t list -> t * children = fun list -> + List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) list, + List.fold_left (fun map v -> ValMap.add v ValSet.empty map) (ValMap.empty) list (** Returns true if v is the representative value of its equivalence class Throws "Unknown value" if v is not present in the data structure. *) - let is_root cc v = match ValMap.find_opt v cc with + let is_root uf v = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) | Some (refv, _) -> Val.compare v (fst !refv) = 0 @@ -50,18 +54,29 @@ module UnionFind (Val: Val) = struct i.e. every node is a root. *) let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst !refv) = 0) (ValMap.bindings uf) + let child_set_add v child children = + match ValMap.find_opt v children with + | None -> ValMap.add v (ValSet.singleton child) children + | Some set -> ValMap.add v (ValSet.add child set) children + + let child_set_remove v child children = + match ValMap.find_opt v children with + | None -> children + | Some set -> ValMap.add v (ValSet.remove child set) children + (** For a variable t it returns the reference variable v and the offset r. + This find performs path compression. Throws "Unknown value" if t is not present in the data structure. *) - let find cc v = match ValMap.find_opt v cc with + let find (uf, children) v = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) | Some (refv,_) -> let (v',r') = !refv in if Val.compare v' v = 0 then - if Z.equal r' Z.zero then (v',r') + if Z.equal r' Z.zero then (v', r', children) else raise (InvalidUnionFind "non-zero self-distance!") - else if is_root cc v' then + else if is_root uf v' then (* let _ = print_string (Val.show v) in let _ = print_string " = " in @@ -70,20 +85,23 @@ module UnionFind (Val: Val) = struct let _ = print_string (Val.show v') in let _ = print_string "\n" in *) - (v',r') + (v', r', children) else - let rec search v list = match ValMap.find_opt v cc with + let rec search v list children = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) - | Some (refv,_) -> let (v',r') = !refv in - if is_root cc v' then - let _ = List.fold_left (fun r0 refv -> - let (_,r'') = !refv in - let _ = refv := (v,Z.(r0+r'')) - in Z.(r0+r'')) r' list - in (v',r') - else search v' (refv :: list) + | Some (refv, _) -> let (v',r') = !refv in + if is_root uf v' then + let (_, children) = List.fold_left (fun (r0, children) (v, refv) -> + (* path compression *) + let (old_v, r'') = !refv in + let _ = refv := (v', Z.(r0 + r'')) + (* update children map *) + in let children = child_set_add v' v (child_set_remove old_v v children) + in Z.(r0 + r''), children) (r', children) list + in (v', r', children) + else search v' ((v, refv) :: list) children in - let v1,r = search v' [refv] in + let v1, r, children = search v' [(v, refv)] children in (* let _ = print_string (Val.show v) in let _ = print_string " = " in @@ -92,15 +110,31 @@ module UnionFind (Val: Val) = struct let _ = print_string (Val.show v1) in let _ = print_string "\n" in *) - v1,r - let find_opt cc v = match find cc v with + v1, r, children + + (** + For a variable t it returns the reference variable v and the offset r. + This find does not perform path compression. + + Throws "Unknown value" if t is not present in the data structure. + *) + let rec find_no_pc uf v = match ValMap.find_opt v uf with + | None -> raise (UnknownValue v) + | Some (refv,_) -> let (v',r') = !refv in + if Val.compare v' v = 0 then + if Z.equal r' Z.zero then (v', r') + else raise (InvalidUnionFind "non-zero self-distance!") + else let (new_v, new_r) = find_no_pc uf v' in + (new_v, Z.(r' + new_r)) + + let find_opt ufc v = match find ufc v with | exception (UnknownValue _) | exception (InvalidUnionFind _) -> None | res -> Some res let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare - let compare_repr_v (v1, _) (v2, _)= Val.compare v1 v2 + let compare_repr_v (v1, _) (v2, _) = Val.compare v1 v2 (** Parameters: part v1 v2 r @@ -116,25 +150,28 @@ module UnionFind (Val: Val) = struct - `b` is true iff v = find v1 *) - let union cc v'1 v'2 r = let v1,r1 = find cc v'1 in - let v2,r2 = find cc v'2 in + let union (uf, children) v'1 v'2 r = + let v1, r1, children = find (uf, children) v'1 in + let v2, r2, children = find (uf, children) v'2 in if Val.compare v1 v2 = 0 then - if r1 = Z.(r2 + r) then v1, cc, true + if r1 = Z.(r2 + r) then v1, uf, children, true else raise (Failure "incomparable union") - else match ValMap.find_opt v1 cc, ValMap.find_opt v2 cc with - | Some (refv1,s1), - Some (refv2,s2) -> + else match ValMap.find_opt v1 uf, ValMap.find_opt v2 uf with + | Some (refv1, s1), + Some (refv2, s2) -> if s1 <= s2 then ( refv1 := (v2, Z.(r2 - r1 + r)); - v2, ValMap.add v2 (refv2,s1+s2) cc, false + let children = child_set_add v2 v1 children in + v2, ValMap.add v2 (refv2,s1+s2) uf, children, false ) else ( refv2 := (v1, Z.(r1 - r2 - r)); - v1, ValMap.add v1 (refv1,s1+s2) cc, true + let children = child_set_add v1 v2 children in + v1, ValMap.add v1 (refv1,s1+s2) uf, children, true ) | None, _ -> raise (UnknownValue v1) | _, _ -> raise (UnknownValue v2) - let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find uf el1) (find uf el2)) (ValMap.bindings uf) + let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> @@ -146,14 +183,14 @@ module UnionFind (Val: Val) = struct ValMap.bindings map |> List.fold_left (fun map (v,node) -> ValMap.add v node map) (ValMap.empty) - let map_find_opt (v,r) map = match ValMap.find_opt v map with + let map_find_opt (v, r) map = match ValMap.find_opt v map with | None -> None | Some zmap -> (match ZMap.find_opt r zmap with | None -> None | Some v -> Some v ) - let map_add (v,r) v' map = match ValMap.find_opt v map with + let map_add (v, r) v' map = match ValMap.find_opt v map with | None -> ValMap.add v (ZMap.add r v' ZMap.empty) map | Some zmap -> ValMap.add v (ZMap.add r v' zmap) map @@ -205,7 +242,8 @@ module CongruenceClosure (Var:Val) = struct type t = {part: part_t; set: set_t; map: map_t; - min_repr: min_repr_t} + min_repr: min_repr_t; + children: TUF.children} [@@deriving eq, ord, hash] let string_of_prop = function @@ -220,11 +258,11 @@ module CongruenceClosure (Var:Val) = struct let print_conj = print_string % show_conj - let rec subterms_of_term (set,map) t = match t with + let rec subterms_of_term (set, map) t = match t with | Addr _ -> (TSet.add t set, map) | Deref (t',z) -> let set = TSet.add t set in - let map = TUF.map_add (t',z) t map in + let map = TUF.map_add (t', z) t map in (* let arg = TUF.map_set_add (t,z) t' arg in *) subterms_of_term (set, map) t' @@ -252,15 +290,15 @@ module CongruenceClosure (Var:Val) = struct let print_min_rep = print_string % show_min_rep - let rec update_min_repr (part, map) min_representatives = function + let rec update_min_repr (part, map, children) min_representatives = function | [] -> min_representatives | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match ZMap.bindings (TMap.find state map) with | exception Not_found -> (* no outgoing edges *) - update_min_repr (part, map) min_representatives queue + update_min_repr (part, map, children) min_representatives queue | edges -> let process_edge (min_representatives, queue) (edge_z, next_term) = - let (next_state, next_z) = TUF.find part next_term in + let (next_state, next_z, children) = TUF.find (part, children) next_term in let (min_term, min_z) = TMap.find state min_representatives in let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in match TMap.find_opt next_state min_representatives @@ -272,7 +310,7 @@ module CongruenceClosure (Var:Val) = struct | _ -> (min_representatives, queue) in let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges - in update_min_repr (part, map) min_representatives queue + in update_min_repr (part, map, children) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of all edges in the queue and if necessary also updates the minimal representatives of @@ -290,11 +328,11 @@ module CongruenceClosure (Var:Val) = struct `queue` contains the states that need to be processed. The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. Therefore the queue is a list of representative terms. *) - let update_min_repr (part, map) min_representatives queue = + let update_min_repr (part, map, children) min_representatives queue = (* order queue by size of the current min representative *) let queue = - List.sort (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue - in update_min_repr (part, map) min_representatives queue + List.sort_unique (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue + in update_min_repr (part, map, children) min_representatives queue let get_atoms set = (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, @@ -305,20 +343,20 @@ module CongruenceClosure (Var:Val) = struct Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. I think it's not used for now, because we compute the minimal representatives incrementally. *) - let compute_minimal_representatives (part, set, map) = + let compute_minimal_representatives (part, set, map, children) = let atoms = get_atoms set in (* process all atoms in increasing order *) let atoms = - List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find part el1) (TUF.find part el2)) atoms in + List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find_no_pc part el1) (TUF.find_no_pc part el2)) atoms in let add_atom_to_map (min_representatives, queue) a = - let (rep, offs) = TUF.find part a in + let (rep, offs, children) = TUF.find (part, children) a in if not (TMap.mem rep min_representatives) then (TMap.add rep (a, offs) min_representatives, queue @ [rep]) else (min_representatives, queue) in let (min_representatives, queue) = List.fold_left add_atom_to_map (TMap.empty, []) atoms (* compute the minimal representative of all remaining edges *) - in update_min_repr (part, map) min_representatives queue + in update_min_repr (part, map, children) min_representatives queue (** Computes the initial map of minimal representatives. @@ -327,7 +365,7 @@ module CongruenceClosure (Var:Val) = struct List.fold_left (fun map element -> TMap.add element (element, Z.zero) map) TMap.empty (TSet.elements set) let get_transitions (part, map) = - List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ ZMap.bindings imap) else None) (TMap.bindings map) + List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find_no_pc part res_t)) @@ ZMap.bindings imap) else None) (TMap.bindings map) (* Runtime = O(nrr. of atoms) + O(nr. transitions in the automata) *) let get_normal_form cc = @@ -337,7 +375,7 @@ module CongruenceClosure (Var:Val) = struct let conjunctions_of_atoms = let atoms = get_atoms cc.set in List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find cc.part atom in + let (rep_state, rep_z) = TUF.find_no_pc cc.part atom in let (min_state, min_z) = TMap.find rep_state cc.min_repr in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms @@ -364,10 +402,10 @@ module CongruenceClosure (Var:Val) = struct *) let init_cc conj = let (set, map) = subterms_of_conj conj in - let part = TSet.elements set |> - TUF.init in + let (part, children) = TSet.elements set |> + TUF.init in let min_repr = initial_minimal_representatives set in - {part = part; set = set; map = map ; min_repr = min_repr} + {part = part; set = set; map = map ; min_repr = min_repr; children=children} (** parameters: (part, map) equalities @@ -383,45 +421,47 @@ module CongruenceClosure (Var:Val) = struct Throws "Unsat" if a contradiction is found. *) - let rec closure (part, map, min_repr) queue = function - | [] -> (part, map, queue, min_repr) - | (t1, t2, r)::rest -> (match TUF.find part t1, TUF.find part t2 with - | (v1,r1), (v2,r2) -> - if T.compare v1 v2 = 0 then - (* t1 and t2 are in the same equivalence class *) - if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest - else raise Unsat - else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) - (* update map *) - let map, rest = match TMap.find_opt v1 map, TMap.find_opt v2 map, b with - | None, _, false -> map, rest - | None, Some _, true -> shift v1 Z.(r1-r2-r) v2 map, rest - | Some _, None,false -> shift v2 Z.(r2-r1+r) v1 map, rest - | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) - | Some imap1, Some imap2, true -> (* v1 is new root *) - (* zmap describes args of Deref *) - let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in - TMap.add v zmap map, rest - | Some imap1, Some imap2, false -> (* v2 is new root *) - let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in - TMap.add v zmap map, rest - in - (* update min_repr *) - let min_repr = - let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in - let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v2 in - TMap.add v (new_min, snd (TUF.find part new_min)) min_repr in - closure (part, map, min_repr) (v :: queue) rest + let rec closure (part, map, min_repr, children) queue = function + | [] -> (part, map, queue, min_repr, children) + | (t1, t2, r)::rest -> ( + let (v1, r1, children) = TUF.find (part, children) t1 in + let (v2, r2, children) = TUF.find (part, children) t2 in + if T.compare v1 v2 = 0 then + (* t1 and t2 are in the same equivalence class *) + if r1 = Z.(r2 + r) then closure (part, map, min_repr, children) queue rest + else raise Unsat + else let v, part, children, b = TUF.union (part, children) v1 v2 Z.(r2 - r1 + r) in (* union *) + (* update map *) + let map, rest = match TMap.find_opt v1 map, TMap.find_opt v2 map, b with + | None, _, false -> map, rest + | None, Some _, true -> shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> shift v2 Z.(r2-r1+r) v1 map, rest + | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in + TMap.add v zmap map, rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in + TMap.add v zmap map, rest + in + (* update min_repr *) + let min_repr, children = + let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in + let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v2 in + let (_, rep_v, children) = TUF.find (part, children) new_min in + TMap.add v (new_min, rep_v) min_repr, children in + closure (part, map, min_repr, children) (v :: queue) rest ) (** @@ -437,9 +477,9 @@ module CongruenceClosure (Var:Val) = struct *) let closure cc conjs = - let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in - let min_repr = update_min_repr (part, map) min_repr queue in - {part = part; set = cc.set; map = map; min_repr = min_repr} + let (part, map, queue, min_repr, children) = closure (cc.part, cc.map, cc.min_repr, cc.children) [] conjs in + let min_repr = update_min_repr (part, map, children) min_repr queue in + {part = part; set = cc.set; map = map; min_repr = min_repr; children=children} let fold_left2 f acc l1 l2 = List.fold_left ( @@ -500,21 +540,23 @@ module CongruenceClosure (Var:Val) = struct Therefore it contains either one or zero elements. *) let rec insert_no_min_repr cc t = if TSet.mem t cc.set then - TUF.find cc.part t, cc,[] + let (r, v, children) = TUF.find (cc.part, cc.children) t in + (r, v), {part = cc.part; set = cc.set; map = cc.map; min_repr = cc.min_repr; children = children}, [] else let set = TSet.add t cc.set in match t with | Addr a -> let part = TMap.add t (ref (t, Z.zero),1) cc.part in let min_repr = TMap.add t (t, Z.zero) cc.min_repr in - (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] + (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr; children = cc.children}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in match TUF.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> TUF.find cc.part v', cc, queue + | Some v' -> let (r, v, children) = TUF.find (cc.part, cc.children) v' in + (r, v), {part = cc.part; set = cc.set; map = cc.map; min_repr = cc.min_repr; children = children}, queue (* TODO don't we need a union here? *) | None -> let map = TUF.map_add (v, Z.(r + z)) t cc.map in let part = TMap.add t (ref (t, Z.zero),1) cc.part in let min_repr = TMap.add t (t, Z.zero) cc.min_repr in - (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, queue + (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr; children = cc.children}, queue (** Add a term to the data structure @@ -522,8 +564,8 @@ module CongruenceClosure (Var:Val) = struct let insert cc t = let v, cc, queue = insert_no_min_repr cc t in (* the queue has at most one element, so there is no need to sort it *) - let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in - v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} + let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in + v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} (** Add all terms in a specific set to the data structure @@ -531,8 +573,8 @@ module CongruenceClosure (Var:Val) = struct let insert_set cc t_set = (* SAFE VERSION but less efficient: TSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in - {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} + let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in + {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} (** @@ -613,10 +655,10 @@ struct It's useless. It's the same as TUF.find_opt. But less efficient. Parameters: Union Find Map and term for which we want to know the final state *) - let rec get_state (part, map) = function + let rec get_state (part, map, children) = function | Addr v -> get_initial_state part v - | Deref (t, z) -> match get_state (part, map) t with + | Deref (t, z) -> match get_state (part, map, children) t with | None -> None - | Some (next_state, z1) -> transition_qfa map (Z.(z + z1)) next_state + | Some (next_state, z1, children) -> transition_qfa map (Z.(z + z1)) next_state end From 2471d7daec45efe7152a83d50a38844973ad9533 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 27 Mar 2024 14:40:28 +0100 Subject: [PATCH 012/323] fixed bug in the handling of children of the union find nodes --- src/cdomains/congruenceClosure.ml | 51 +++++++++++++++++++------------ 1 file changed, 31 insertions(+), 20 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index f5c5e0629f..884488804c 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -176,7 +176,8 @@ module UnionFind (Val: Val) = struct (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> s ^ List.fold_left (fun s (v, _) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "\n") "" eq_class + let (refv, size) = ValMap.find v uf in + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" let clone map = @@ -204,6 +205,16 @@ module UnionFind (Val: Val) = struct "" (ZMap.bindings zmap) ^ "\n") "" (ValMap.bindings map) + let show_children map = + List.fold_left + (fun s (v, set) -> + s ^ "Children of " ^ Val.show v ^ ":\n" ^ + List.fold_left + (fun s v -> + s ^ Val.show v ^ "; ") + "" (ValSet.elements set) ^ "\n") + "" (ValMap.bindings map) + let print_map = print_string % show_map let show_set set = ValSet.fold (fun v s -> @@ -291,25 +302,25 @@ module CongruenceClosure (Var:Val) = struct let print_min_rep = print_string % show_min_rep let rec update_min_repr (part, map, children) min_representatives = function - | [] -> min_representatives + | [] -> min_representatives, children | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match ZMap.bindings (TMap.find state map) with | exception Not_found -> (* no outgoing edges *) update_min_repr (part, map, children) min_representatives queue | edges -> - let process_edge (min_representatives, queue) (edge_z, next_term) = + let process_edge (min_representatives, queue, children) (edge_z, next_term) = let (next_state, next_z, children) = TUF.find (part, children) next_term in let (min_term, min_z) = TMap.find state min_representatives in let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in match TMap.find_opt next_state min_representatives with | None -> - (TMap.add next_state next_min min_representatives, queue @ [next_state]) + (TMap.add next_state next_min min_representatives, queue @ [next_state], children) (* | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> (TMap.add next_state next_min min_representatives, queue @ [next_state])*) - | _ -> (min_representatives, queue) + | _ -> (min_representatives, queue, children) in - let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges + let (min_representatives, queue, children) = List.fold_left process_edge (min_representatives, queue, children) edges in update_min_repr (part, map, children) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of @@ -348,13 +359,13 @@ module CongruenceClosure (Var:Val) = struct (* process all atoms in increasing order *) let atoms = List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find_no_pc part el1) (TUF.find_no_pc part el2)) atoms in - let add_atom_to_map (min_representatives, queue) a = + let add_atom_to_map (min_representatives, queue, children) a = let (rep, offs, children) = TUF.find (part, children) a in if not (TMap.mem rep min_representatives) then - (TMap.add rep (a, offs) min_representatives, queue @ [rep]) - else (min_representatives, queue) + (TMap.add rep (a, offs) min_representatives, queue @ [rep], children) + else (min_representatives, queue, children) in - let (min_representatives, queue) = List.fold_left add_atom_to_map (TMap.empty, []) atoms + let (min_representatives, queue, children) = List.fold_left add_atom_to_map (TMap.empty, [], children) atoms (* compute the minimal representative of all remaining edges *) in update_min_repr (part, map, children) min_representatives queue @@ -478,7 +489,7 @@ module CongruenceClosure (Var:Val) = struct *) let closure cc conjs = let (part, map, queue, min_repr, children) = closure (cc.part, cc.map, cc.min_repr, cc.children) [] conjs in - let min_repr = update_min_repr (part, map, children) min_repr queue in + let min_repr, children = update_min_repr (part, map, children) min_repr queue in {part = part; set = cc.set; map = map; min_repr = min_repr; children=children} let fold_left2 f acc l1 l2 = @@ -564,8 +575,8 @@ module CongruenceClosure (Var:Val) = struct let insert cc t = let v, cc, queue = insert_no_min_repr cc t in (* the queue has at most one element, so there is no need to sort it *) - let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in - v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} + let min_repr, children = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in + v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = children} (** Add all terms in a specific set to the data structure @@ -573,8 +584,8 @@ module CongruenceClosure (Var:Val) = struct let insert_set cc t_set = (* SAFE VERSION but less efficient: TSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in - {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} + let min_repr, children = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in + {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = children} (** @@ -634,7 +645,7 @@ struct (** Returns the initial state of the QFA for a certain variable Parameters: Union Find Map and variable for which we want to know the initial state *) - let get_initial_state part var = TUF.find_opt part (Addr var) + let get_initial_state (part, children) var = TUF.find_opt (part, children) (Addr var) (* pag. 8 before proposition 1 *) (** Returns the transition of the QFA for a certain Z, starting from a certain state @@ -644,8 +655,8 @@ struct - Lookup Map - Z and State for which we want to know the next state *) - let transition_qfa (part, map) z state = match TUF.map_find_opt (state, z) map with - | Some term -> TUF.find_opt part term + let transition_qfa (part, map, children) z state = match TUF.map_find_opt (state, z) map with + | Some term -> TUF.find_opt (part, children) term | None -> None @@ -656,9 +667,9 @@ struct Parameters: Union Find Map and term for which we want to know the final state *) let rec get_state (part, map, children) = function - | Addr v -> get_initial_state part v + | Addr v -> get_initial_state (part, children) v | Deref (t, z) -> match get_state (part, map, children) t with | None -> None - | Some (next_state, z1, children) -> transition_qfa map (Z.(z + z1)) next_state + | Some (next_state, z1, children) -> transition_qfa (part, map, children) (Z.(z + z1)) next_state end From 8a255af2935dd021e9af1903c69eeccf3a12a2fa Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 27 Mar 2024 16:00:48 +0100 Subject: [PATCH 013/323] Revert "fixed bug in the handling of children of the union find nodes" This reverts commit 2471d7daec45efe7152a83d50a38844973ad9533. --- src/cdomains/congruenceClosure.ml | 51 ++++++++++++------------------- 1 file changed, 20 insertions(+), 31 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 884488804c..f5c5e0629f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -176,8 +176,7 @@ module UnionFind (Val: Val) = struct (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> s ^ List.fold_left (fun s (v, _) -> - let (refv, size) = ValMap.find v uf in - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" let clone map = @@ -205,16 +204,6 @@ module UnionFind (Val: Val) = struct "" (ZMap.bindings zmap) ^ "\n") "" (ValMap.bindings map) - let show_children map = - List.fold_left - (fun s (v, set) -> - s ^ "Children of " ^ Val.show v ^ ":\n" ^ - List.fold_left - (fun s v -> - s ^ Val.show v ^ "; ") - "" (ValSet.elements set) ^ "\n") - "" (ValMap.bindings map) - let print_map = print_string % show_map let show_set set = ValSet.fold (fun v s -> @@ -302,25 +291,25 @@ module CongruenceClosure (Var:Val) = struct let print_min_rep = print_string % show_min_rep let rec update_min_repr (part, map, children) min_representatives = function - | [] -> min_representatives, children + | [] -> min_representatives | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match ZMap.bindings (TMap.find state map) with | exception Not_found -> (* no outgoing edges *) update_min_repr (part, map, children) min_representatives queue | edges -> - let process_edge (min_representatives, queue, children) (edge_z, next_term) = + let process_edge (min_representatives, queue) (edge_z, next_term) = let (next_state, next_z, children) = TUF.find (part, children) next_term in let (min_term, min_z) = TMap.find state min_representatives in let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in match TMap.find_opt next_state min_representatives with | None -> - (TMap.add next_state next_min min_representatives, queue @ [next_state], children) + (TMap.add next_state next_min min_representatives, queue @ [next_state]) (* | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> (TMap.add next_state next_min min_representatives, queue @ [next_state])*) - | _ -> (min_representatives, queue, children) + | _ -> (min_representatives, queue) in - let (min_representatives, queue, children) = List.fold_left process_edge (min_representatives, queue, children) edges + let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges in update_min_repr (part, map, children) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of @@ -359,13 +348,13 @@ module CongruenceClosure (Var:Val) = struct (* process all atoms in increasing order *) let atoms = List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find_no_pc part el1) (TUF.find_no_pc part el2)) atoms in - let add_atom_to_map (min_representatives, queue, children) a = + let add_atom_to_map (min_representatives, queue) a = let (rep, offs, children) = TUF.find (part, children) a in if not (TMap.mem rep min_representatives) then - (TMap.add rep (a, offs) min_representatives, queue @ [rep], children) - else (min_representatives, queue, children) + (TMap.add rep (a, offs) min_representatives, queue @ [rep]) + else (min_representatives, queue) in - let (min_representatives, queue, children) = List.fold_left add_atom_to_map (TMap.empty, [], children) atoms + let (min_representatives, queue) = List.fold_left add_atom_to_map (TMap.empty, []) atoms (* compute the minimal representative of all remaining edges *) in update_min_repr (part, map, children) min_representatives queue @@ -489,7 +478,7 @@ module CongruenceClosure (Var:Val) = struct *) let closure cc conjs = let (part, map, queue, min_repr, children) = closure (cc.part, cc.map, cc.min_repr, cc.children) [] conjs in - let min_repr, children = update_min_repr (part, map, children) min_repr queue in + let min_repr = update_min_repr (part, map, children) min_repr queue in {part = part; set = cc.set; map = map; min_repr = min_repr; children=children} let fold_left2 f acc l1 l2 = @@ -575,8 +564,8 @@ module CongruenceClosure (Var:Val) = struct let insert cc t = let v, cc, queue = insert_no_min_repr cc t in (* the queue has at most one element, so there is no need to sort it *) - let min_repr, children = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in - v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = children} + let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in + v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} (** Add all terms in a specific set to the data structure @@ -584,8 +573,8 @@ module CongruenceClosure (Var:Val) = struct let insert_set cc t_set = (* SAFE VERSION but less efficient: TSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr, children = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in - {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = children} + let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in + {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} (** @@ -645,7 +634,7 @@ struct (** Returns the initial state of the QFA for a certain variable Parameters: Union Find Map and variable for which we want to know the initial state *) - let get_initial_state (part, children) var = TUF.find_opt (part, children) (Addr var) + let get_initial_state part var = TUF.find_opt part (Addr var) (* pag. 8 before proposition 1 *) (** Returns the transition of the QFA for a certain Z, starting from a certain state @@ -655,8 +644,8 @@ struct - Lookup Map - Z and State for which we want to know the next state *) - let transition_qfa (part, map, children) z state = match TUF.map_find_opt (state, z) map with - | Some term -> TUF.find_opt (part, children) term + let transition_qfa (part, map) z state = match TUF.map_find_opt (state, z) map with + | Some term -> TUF.find_opt part term | None -> None @@ -667,9 +656,9 @@ struct Parameters: Union Find Map and term for which we want to know the final state *) let rec get_state (part, map, children) = function - | Addr v -> get_initial_state (part, children) v + | Addr v -> get_initial_state part v | Deref (t, z) -> match get_state (part, map, children) t with | None -> None - | Some (next_state, z1, children) -> transition_qfa (part, map, children) (Z.(z + z1)) next_state + | Some (next_state, z1, children) -> transition_qfa map (Z.(z + z1)) next_state end From 7c4f0a0b5d9db2ee664ed8f3b06be3aca98babf3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 27 Mar 2024 16:01:07 +0100 Subject: [PATCH 014/323] Revert "started implementing a map htat maps nodes to their children" This reverts commit e8d5456365e3b43fb03747216cb531b8956cebe3. --- src/cdomains/congruenceClosure.ml | 248 +++++++++++++----------------- 1 file changed, 103 insertions(+), 145 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index f5c5e0629f..afc848caf9 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -30,23 +30,19 @@ module UnionFind (Val: Val) = struct (** (value * offset) ref * size of equivalence class *) type 'v node = ('v * Z.t) ref * int [@@deriving eq, ord, hash] - type children = ValSet.t ValMap.t [@@deriving eq, ord, hash] - (** Maps each value to its children in the union find data structure. - Necessary in order to be able to delete values. *) type t = Val.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) exception UnknownValue of Val.t exception InvalidUnionFind of string (** create empty union find map *) - let init : Val.t list -> t * children = fun list -> - List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) list, - List.fold_left (fun map v -> ValMap.add v ValSet.empty map) (ValMap.empty) list + let init : Val.t list -> t = + List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) (** Returns true if v is the representative value of its equivalence class Throws "Unknown value" if v is not present in the data structure. *) - let is_root uf v = match ValMap.find_opt v uf with + let is_root cc v = match ValMap.find_opt v cc with | None -> raise (UnknownValue v) | Some (refv, _) -> Val.compare v (fst !refv) = 0 @@ -54,29 +50,18 @@ module UnionFind (Val: Val) = struct i.e. every node is a root. *) let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst !refv) = 0) (ValMap.bindings uf) - let child_set_add v child children = - match ValMap.find_opt v children with - | None -> ValMap.add v (ValSet.singleton child) children - | Some set -> ValMap.add v (ValSet.add child set) children - - let child_set_remove v child children = - match ValMap.find_opt v children with - | None -> children - | Some set -> ValMap.add v (ValSet.remove child set) children - (** For a variable t it returns the reference variable v and the offset r. - This find performs path compression. Throws "Unknown value" if t is not present in the data structure. *) - let find (uf, children) v = match ValMap.find_opt v uf with + let find cc v = match ValMap.find_opt v cc with | None -> raise (UnknownValue v) | Some (refv,_) -> let (v',r') = !refv in if Val.compare v' v = 0 then - if Z.equal r' Z.zero then (v', r', children) + if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") - else if is_root uf v' then + else if is_root cc v' then (* let _ = print_string (Val.show v) in let _ = print_string " = " in @@ -85,23 +70,20 @@ module UnionFind (Val: Val) = struct let _ = print_string (Val.show v') in let _ = print_string "\n" in *) - (v', r', children) + (v',r') else - let rec search v list children = match ValMap.find_opt v uf with + let rec search v list = match ValMap.find_opt v cc with | None -> raise (UnknownValue v) - | Some (refv, _) -> let (v',r') = !refv in - if is_root uf v' then - let (_, children) = List.fold_left (fun (r0, children) (v, refv) -> - (* path compression *) - let (old_v, r'') = !refv in - let _ = refv := (v', Z.(r0 + r'')) - (* update children map *) - in let children = child_set_add v' v (child_set_remove old_v v children) - in Z.(r0 + r''), children) (r', children) list - in (v', r', children) - else search v' ((v, refv) :: list) children + | Some (refv,_) -> let (v',r') = !refv in + if is_root cc v' then + let _ = List.fold_left (fun r0 refv -> + let (_,r'') = !refv in + let _ = refv := (v,Z.(r0+r'')) + in Z.(r0+r'')) r' list + in (v',r') + else search v' (refv :: list) in - let v1, r, children = search v' [(v, refv)] children in + let v1,r = search v' [refv] in (* let _ = print_string (Val.show v) in let _ = print_string " = " in @@ -110,31 +92,15 @@ module UnionFind (Val: Val) = struct let _ = print_string (Val.show v1) in let _ = print_string "\n" in *) - v1, r, children - - (** - For a variable t it returns the reference variable v and the offset r. - This find does not perform path compression. - - Throws "Unknown value" if t is not present in the data structure. - *) - let rec find_no_pc uf v = match ValMap.find_opt v uf with - | None -> raise (UnknownValue v) - | Some (refv,_) -> let (v',r') = !refv in - if Val.compare v' v = 0 then - if Z.equal r' Z.zero then (v', r') - else raise (InvalidUnionFind "non-zero self-distance!") - else let (new_v, new_r) = find_no_pc uf v' in - (new_v, Z.(r' + new_r)) - - let find_opt ufc v = match find ufc v with + v1,r + let find_opt cc v = match find cc v with | exception (UnknownValue _) | exception (InvalidUnionFind _) -> None | res -> Some res let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare - let compare_repr_v (v1, _) (v2, _) = Val.compare v1 v2 + let compare_repr_v (v1, _) (v2, _)= Val.compare v1 v2 (** Parameters: part v1 v2 r @@ -150,28 +116,25 @@ module UnionFind (Val: Val) = struct - `b` is true iff v = find v1 *) - let union (uf, children) v'1 v'2 r = - let v1, r1, children = find (uf, children) v'1 in - let v2, r2, children = find (uf, children) v'2 in + let union cc v'1 v'2 r = let v1,r1 = find cc v'1 in + let v2,r2 = find cc v'2 in if Val.compare v1 v2 = 0 then - if r1 = Z.(r2 + r) then v1, uf, children, true + if r1 = Z.(r2 + r) then v1, cc, true else raise (Failure "incomparable union") - else match ValMap.find_opt v1 uf, ValMap.find_opt v2 uf with - | Some (refv1, s1), - Some (refv2, s2) -> + else match ValMap.find_opt v1 cc, ValMap.find_opt v2 cc with + | Some (refv1,s1), + Some (refv2,s2) -> if s1 <= s2 then ( refv1 := (v2, Z.(r2 - r1 + r)); - let children = child_set_add v2 v1 children in - v2, ValMap.add v2 (refv2,s1+s2) uf, children, false + v2, ValMap.add v2 (refv2,s1+s2) cc, false ) else ( refv2 := (v1, Z.(r1 - r2 - r)); - let children = child_set_add v1 v2 children in - v1, ValMap.add v1 (refv1,s1+s2) uf, children, true + v1, ValMap.add v1 (refv1,s1+s2) cc, true ) | None, _ -> raise (UnknownValue v1) | _, _ -> raise (UnknownValue v2) - let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) + let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find uf el1) (find uf el2)) (ValMap.bindings uf) (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> @@ -183,14 +146,14 @@ module UnionFind (Val: Val) = struct ValMap.bindings map |> List.fold_left (fun map (v,node) -> ValMap.add v node map) (ValMap.empty) - let map_find_opt (v, r) map = match ValMap.find_opt v map with + let map_find_opt (v,r) map = match ValMap.find_opt v map with | None -> None | Some zmap -> (match ZMap.find_opt r zmap with | None -> None | Some v -> Some v ) - let map_add (v, r) v' map = match ValMap.find_opt v map with + let map_add (v,r) v' map = match ValMap.find_opt v map with | None -> ValMap.add v (ZMap.add r v' ZMap.empty) map | Some zmap -> ValMap.add v (ZMap.add r v' zmap) map @@ -242,8 +205,7 @@ module CongruenceClosure (Var:Val) = struct type t = {part: part_t; set: set_t; map: map_t; - min_repr: min_repr_t; - children: TUF.children} + min_repr: min_repr_t} [@@deriving eq, ord, hash] let string_of_prop = function @@ -258,11 +220,11 @@ module CongruenceClosure (Var:Val) = struct let print_conj = print_string % show_conj - let rec subterms_of_term (set, map) t = match t with + let rec subterms_of_term (set,map) t = match t with | Addr _ -> (TSet.add t set, map) | Deref (t',z) -> let set = TSet.add t set in - let map = TUF.map_add (t', z) t map in + let map = TUF.map_add (t',z) t map in (* let arg = TUF.map_set_add (t,z) t' arg in *) subterms_of_term (set, map) t' @@ -290,15 +252,15 @@ module CongruenceClosure (Var:Val) = struct let print_min_rep = print_string % show_min_rep - let rec update_min_repr (part, map, children) min_representatives = function + let rec update_min_repr (part, map) min_representatives = function | [] -> min_representatives | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match ZMap.bindings (TMap.find state map) with | exception Not_found -> (* no outgoing edges *) - update_min_repr (part, map, children) min_representatives queue + update_min_repr (part, map) min_representatives queue | edges -> let process_edge (min_representatives, queue) (edge_z, next_term) = - let (next_state, next_z, children) = TUF.find (part, children) next_term in + let (next_state, next_z) = TUF.find part next_term in let (min_term, min_z) = TMap.find state min_representatives in let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in match TMap.find_opt next_state min_representatives @@ -310,7 +272,7 @@ module CongruenceClosure (Var:Val) = struct | _ -> (min_representatives, queue) in let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges - in update_min_repr (part, map, children) min_representatives queue + in update_min_repr (part, map) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of all edges in the queue and if necessary also updates the minimal representatives of @@ -328,11 +290,11 @@ module CongruenceClosure (Var:Val) = struct `queue` contains the states that need to be processed. The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. Therefore the queue is a list of representative terms. *) - let update_min_repr (part, map, children) min_representatives queue = + let update_min_repr (part, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = - List.sort_unique (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue - in update_min_repr (part, map, children) min_representatives queue + List.sort (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue + in update_min_repr (part, map) min_representatives queue let get_atoms set = (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, @@ -343,20 +305,20 @@ module CongruenceClosure (Var:Val) = struct Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. I think it's not used for now, because we compute the minimal representatives incrementally. *) - let compute_minimal_representatives (part, set, map, children) = + let compute_minimal_representatives (part, set, map) = let atoms = get_atoms set in (* process all atoms in increasing order *) let atoms = - List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find_no_pc part el1) (TUF.find_no_pc part el2)) atoms in + List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find part el1) (TUF.find part el2)) atoms in let add_atom_to_map (min_representatives, queue) a = - let (rep, offs, children) = TUF.find (part, children) a in + let (rep, offs) = TUF.find part a in if not (TMap.mem rep min_representatives) then (TMap.add rep (a, offs) min_representatives, queue @ [rep]) else (min_representatives, queue) in let (min_representatives, queue) = List.fold_left add_atom_to_map (TMap.empty, []) atoms (* compute the minimal representative of all remaining edges *) - in update_min_repr (part, map, children) min_representatives queue + in update_min_repr (part, map) min_representatives queue (** Computes the initial map of minimal representatives. @@ -365,7 +327,7 @@ module CongruenceClosure (Var:Val) = struct List.fold_left (fun map element -> TMap.add element (element, Z.zero) map) TMap.empty (TSet.elements set) let get_transitions (part, map) = - List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find_no_pc part res_t)) @@ ZMap.bindings imap) else None) (TMap.bindings map) + List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ ZMap.bindings imap) else None) (TMap.bindings map) (* Runtime = O(nrr. of atoms) + O(nr. transitions in the automata) *) let get_normal_form cc = @@ -375,7 +337,7 @@ module CongruenceClosure (Var:Val) = struct let conjunctions_of_atoms = let atoms = get_atoms cc.set in List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find_no_pc cc.part atom in + let (rep_state, rep_z) = TUF.find cc.part atom in let (min_state, min_z) = TMap.find rep_state cc.min_repr in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms @@ -402,10 +364,10 @@ module CongruenceClosure (Var:Val) = struct *) let init_cc conj = let (set, map) = subterms_of_conj conj in - let (part, children) = TSet.elements set |> - TUF.init in + let part = TSet.elements set |> + TUF.init in let min_repr = initial_minimal_representatives set in - {part = part; set = set; map = map ; min_repr = min_repr; children=children} + {part = part; set = set; map = map ; min_repr = min_repr} (** parameters: (part, map) equalities @@ -421,47 +383,45 @@ module CongruenceClosure (Var:Val) = struct Throws "Unsat" if a contradiction is found. *) - let rec closure (part, map, min_repr, children) queue = function - | [] -> (part, map, queue, min_repr, children) - | (t1, t2, r)::rest -> ( - let (v1, r1, children) = TUF.find (part, children) t1 in - let (v2, r2, children) = TUF.find (part, children) t2 in - if T.compare v1 v2 = 0 then - (* t1 and t2 are in the same equivalence class *) - if r1 = Z.(r2 + r) then closure (part, map, min_repr, children) queue rest - else raise Unsat - else let v, part, children, b = TUF.union (part, children) v1 v2 Z.(r2 - r1 + r) in (* union *) - (* update map *) - let map, rest = match TMap.find_opt v1 map, TMap.find_opt v2 map, b with - | None, _, false -> map, rest - | None, Some _, true -> shift v1 Z.(r1-r2-r) v2 map, rest - | Some _, None,false -> shift v2 Z.(r2-r1+r) v1 map, rest - | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) - | Some imap1, Some imap2, true -> (* v1 is new root *) - (* zmap describes args of Deref *) - let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in - TMap.add v zmap map, rest - | Some imap1, Some imap2, false -> (* v2 is new root *) - let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in - TMap.add v zmap map, rest - in - (* update min_repr *) - let min_repr, children = - let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in - let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v2 in - let (_, rep_v, children) = TUF.find (part, children) new_min in - TMap.add v (new_min, rep_v) min_repr, children in - closure (part, map, min_repr, children) (v :: queue) rest + let rec closure (part, map, min_repr) queue = function + | [] -> (part, map, queue, min_repr) + | (t1, t2, r)::rest -> (match TUF.find part t1, TUF.find part t2 with + | (v1,r1), (v2,r2) -> + if T.compare v1 v2 = 0 then + (* t1 and t2 are in the same equivalence class *) + if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest + else raise Unsat + else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) + (* update map *) + let map, rest = match TMap.find_opt v1 map, TMap.find_opt v2 map, b with + | None, _, false -> map, rest + | None, Some _, true -> shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> shift v2 Z.(r2-r1+r) v1 map, rest + | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in + TMap.add v zmap map, rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match ZMap.find_opt r' zmap with + | None -> (ZMap.add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in + TMap.add v zmap map, rest + in + (* update min_repr *) + let min_repr = + let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in + let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v2 in + TMap.add v (new_min, snd (TUF.find part new_min)) min_repr in + closure (part, map, min_repr) (v :: queue) rest ) (** @@ -477,9 +437,9 @@ module CongruenceClosure (Var:Val) = struct *) let closure cc conjs = - let (part, map, queue, min_repr, children) = closure (cc.part, cc.map, cc.min_repr, cc.children) [] conjs in - let min_repr = update_min_repr (part, map, children) min_repr queue in - {part = part; set = cc.set; map = map; min_repr = min_repr; children=children} + let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in + let min_repr = update_min_repr (part, map) min_repr queue in + {part = part; set = cc.set; map = map; min_repr = min_repr} let fold_left2 f acc l1 l2 = List.fold_left ( @@ -540,23 +500,21 @@ module CongruenceClosure (Var:Val) = struct Therefore it contains either one or zero elements. *) let rec insert_no_min_repr cc t = if TSet.mem t cc.set then - let (r, v, children) = TUF.find (cc.part, cc.children) t in - (r, v), {part = cc.part; set = cc.set; map = cc.map; min_repr = cc.min_repr; children = children}, [] + TUF.find cc.part t, cc,[] else let set = TSet.add t cc.set in match t with | Addr a -> let part = TMap.add t (ref (t, Z.zero),1) cc.part in let min_repr = TMap.add t (t, Z.zero) cc.min_repr in - (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr; children = cc.children}, [Addr a] + (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in match TUF.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> let (r, v, children) = TUF.find (cc.part, cc.children) v' in - (r, v), {part = cc.part; set = cc.set; map = cc.map; min_repr = cc.min_repr; children = children}, queue + | Some v' -> TUF.find cc.part v', cc, queue (* TODO don't we need a union here? *) | None -> let map = TUF.map_add (v, Z.(r + z)) t cc.map in let part = TMap.add t (ref (t, Z.zero),1) cc.part in let min_repr = TMap.add t (t, Z.zero) cc.min_repr in - (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr; children = cc.children}, queue + (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, queue (** Add a term to the data structure @@ -564,8 +522,8 @@ module CongruenceClosure (Var:Val) = struct let insert cc t = let v, cc, queue = insert_no_min_repr cc t in (* the queue has at most one element, so there is no need to sort it *) - let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in - v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} + let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in + v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} (** Add all terms in a specific set to the data structure @@ -573,8 +531,8 @@ module CongruenceClosure (Var:Val) = struct let insert_set cc t_set = (* SAFE VERSION but less efficient: TSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr = update_min_repr (cc.part, cc.map, cc.children) cc.min_repr queue in - {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr; children = cc.children} + let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in + {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} (** @@ -655,10 +613,10 @@ struct It's useless. It's the same as TUF.find_opt. But less efficient. Parameters: Union Find Map and term for which we want to know the final state *) - let rec get_state (part, map, children) = function + let rec get_state (part, map) = function | Addr v -> get_initial_state part v - | Deref (t, z) -> match get_state (part, map, children) t with + | Deref (t, z) -> match get_state (part, map) t with | None -> None - | Some (next_state, z1, children) -> transition_qfa map (Z.(z + z1)) next_state + | Some (next_state, z1) -> transition_qfa map (Z.(z + z1)) next_state end From dd47d19c6deb9b56a203e5ebf0512b36e201f0cb Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 27 Mar 2024 16:09:53 +0100 Subject: [PATCH 015/323] code style changes --- src/cdomains/congruenceClosure.ml | 45 +++++++++++++++++-------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index afc848caf9..c6d3351abf 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -52,16 +52,17 @@ module UnionFind (Val: Val) = struct (** For a variable t it returns the reference variable v and the offset r. + This find performs path compression. Throws "Unknown value" if t is not present in the data structure. *) - let find cc v = match ValMap.find_opt v cc with + let find uf v = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) | Some (refv,_) -> let (v',r') = !refv in if Val.compare v' v = 0 then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") - else if is_root cc v' then + else if is_root uf v' then (* let _ = print_string (Val.show v) in let _ = print_string " = " in @@ -72,10 +73,10 @@ module UnionFind (Val: Val) = struct *) (v',r') else - let rec search v list = match ValMap.find_opt v cc with + let rec search v list = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) | Some (refv,_) -> let (v',r') = !refv in - if is_root cc v' then + if is_root uf v' then let _ = List.fold_left (fun r0 refv -> let (_,r'') = !refv in let _ = refv := (v,Z.(r0+r'')) @@ -93,7 +94,8 @@ module UnionFind (Val: Val) = struct let _ = print_string "\n" in *) v1,r - let find_opt cc v = match find cc v with + + let find_opt uf v = match find uf v with | exception (UnknownValue _) | exception (InvalidUnionFind _) -> None | res -> Some res @@ -116,20 +118,20 @@ module UnionFind (Val: Val) = struct - `b` is true iff v = find v1 *) - let union cc v'1 v'2 r = let v1,r1 = find cc v'1 in - let v2,r2 = find cc v'2 in + let union uf v'1 v'2 r = let v1,r1 = find uf v'1 in + let v2,r2 = find uf v'2 in if Val.compare v1 v2 = 0 then - if r1 = Z.(r2 + r) then v1, cc, true + if r1 = Z.(r2 + r) then v1, uf, true else raise (Failure "incomparable union") - else match ValMap.find_opt v1 cc, ValMap.find_opt v2 cc with + else match ValMap.find_opt v1 uf, ValMap.find_opt v2 uf with | Some (refv1,s1), Some (refv2,s2) -> if s1 <= s2 then ( refv1 := (v2, Z.(r2 - r1 + r)); - v2, ValMap.add v2 (refv2,s1+s2) cc, false + v2, ValMap.add v2 (refv2,s1+s2) uf, false ) else ( refv2 := (v1, Z.(r1 - r2 - r)); - v1, ValMap.add v1 (refv1,s1+s2) cc, true + v1, ValMap.add v1 (refv1,s1+s2) uf, true ) | None, _ -> raise (UnknownValue v1) | _, _ -> raise (UnknownValue v2) @@ -139,7 +141,8 @@ module UnionFind (Val: Val) = struct (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> s ^ List.fold_left (fun s (v, _) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "\n") "" eq_class + let (refv, size) = ValMap.find v uf in + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" let clone map = @@ -267,8 +270,8 @@ module CongruenceClosure (Var:Val) = struct with | None -> (TMap.add next_state next_min min_representatives, queue @ [next_state]) - (* | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (TMap.add next_state next_min min_representatives, queue @ [next_state])*) + | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> + (TMap.add next_state next_min min_representatives, queue @ [next_state]) | _ -> (min_representatives, queue) in let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges @@ -293,7 +296,7 @@ module CongruenceClosure (Var:Val) = struct let update_min_repr (part, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = - List.sort (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue + List.sort_unique (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue in update_min_repr (part, map) min_representatives queue let get_atoms set = @@ -417,11 +420,13 @@ module CongruenceClosure (Var:Val) = struct TMap.add v zmap map, rest in (* update min_repr *) - let min_repr = - let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in - let new_min = if min_v1 <= min_v2 then fst min_v1 else fst min_v2 in - TMap.add v (new_min, snd (TUF.find part new_min)) min_repr in - closure (part, map, min_repr) (v :: queue) rest + let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in + (* 'changed' is true if the new_min is different thatn the old min *) + let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in + let (_, rep_v) = TUF.find part new_min in + let min_repr = if changed then TMap.add v (new_min, rep_v) min_repr else min_repr in + let queue = if changed then (v :: queue) else queue in + closure (part, map, min_repr) queue rest ) (** From 63a68817876c4228d1836e72b2433f235735a203 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 28 Mar 2024 10:38:52 +0100 Subject: [PATCH 016/323] some refactoring for better readability (hopefully?) --- src/cdomains/congruenceClosure.ml | 518 +++++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 10 +- 2 files changed, 251 insertions(+), 277 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c6d3351abf..6607301595 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -10,20 +10,15 @@ module type Val = sig val hash : t -> int end +module ValMap(Val:Val) = struct + include Map.Make(Val) + let hash x y = 3 +end + + (** Quantitative union find *) module UnionFind (Val: Val) = struct - module ValMap = struct - include Map.Make(Val) - let hash x y = 3 - end - module ZMap = struct - include Map.Make(Z) - let hash x y = 3 - end - module ValSet = struct - include Set.Make(Val) - let hash x = 3 - end + module ValMap = ValMap(Val) let hash_ref x y = 3 @@ -35,6 +30,8 @@ module UnionFind (Val: Val) = struct exception UnknownValue of Val.t exception InvalidUnionFind of string + let empty = ValMap.empty + (** create empty union find map *) let init : Val.t list -> t = List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) @@ -63,14 +60,6 @@ module UnionFind (Val: Val) = struct if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") else if is_root uf v' then - (* - let _ = print_string (Val.show v) in - let _ = print_string " = " in - let _ = print_string (string_of_int r') in - let _ = print_string "+" in - let _ = print_string (Val.show v') in - let _ = print_string "\n" in - *) (v',r') else let rec search v list = match ValMap.find_opt v uf with @@ -85,16 +74,14 @@ module UnionFind (Val: Val) = struct else search v' (refv :: list) in let v1,r = search v' [refv] in - (* - let _ = print_string (Val.show v) in - let _ = print_string " = " in - let _ = print_string (string_of_int r) in - let _ = print_string "+" in - let _ = print_string (Val.show v1) in - let _ = print_string "\n" in - *) v1,r + (** + For a variable t it returns the reference variable v and the offset r. + This find performs path compression. + + Returns "None" if t is not present in the data structure. + *) let find_opt uf v = match find uf v with | exception (UnknownValue _) | exception (InvalidUnionFind _) -> None @@ -102,7 +89,7 @@ module UnionFind (Val: Val) = struct let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare - let compare_repr_v (v1, _) (v2, _)= Val.compare v1 v2 + let compare_repr_v (v1, _) (v2, _) = Val.compare v1 v2 (** Parameters: part v1 v2 r @@ -144,193 +131,245 @@ module UnionFind (Val: Val) = struct let (refv, size) = ValMap.find v uf in s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" +end - let clone map = - ValMap.bindings map |> - List.fold_left (fun map (v,node) -> ValMap.add v node map) (ValMap.empty) - let map_find_opt (v,r) map = match ValMap.find_opt v map with +module LookupMap (T: Val) = struct + module TMap = ValMap(T) + + module ZMap = struct + include Map.Make(Z) + let hash x y = 3 + end + + type t = T.t ZMap.t TMap.t [@@deriving eq, ord, hash] + + let bindings = TMap.bindings + let add = TMap.add + let empty = TMap.empty + let find_opt = TMap.find_opt + let find = TMap.find + + let zmap_bindings = ZMap.bindings + let zmap_add = ZMap.add + let zmap_find_opt = ZMap.find_opt + + let map_find_opt (v,r) map = match TMap.find_opt v map with | None -> None | Some zmap -> (match ZMap.find_opt r zmap with | None -> None | Some v -> Some v ) - let map_add (v,r) v' map = match ValMap.find_opt v map with - | None -> ValMap.add v (ZMap.add r v' ZMap.empty) map - | Some zmap -> ValMap.add v (ZMap.add r v' zmap) map + let map_add (v,r) v' map = match TMap.find_opt v map with + | None -> TMap.add v (ZMap.add r v' ZMap.empty) map + | Some zmap -> TMap.add v (ZMap.add r v' zmap) map let show_map map = List.fold_left (fun s (v, zmap) -> - s ^ Val.show v ^ "\t:\n" ^ + s ^ T.show v ^ "\t:\n" ^ List.fold_left (fun s (r, v) -> - s ^ "\t" ^ Z.to_string r ^ ": " ^ Val.show v ^ "; ") + s ^ "\t" ^ Z.to_string r ^ ": " ^ T.show v ^ "; ") "" (ZMap.bindings zmap) ^ "\n") - "" (ValMap.bindings map) + "" (TMap.bindings map) let print_map = print_string % show_map - let show_set set = ValSet.fold (fun v s -> - s ^ "\t" ^ Val.show v ^ "\n") set "" ^ "\n" -end + let clone map = + TMap.bindings map |> + List.fold_left (fun map (v,node) -> TMap.add v node map) (TMap.empty) -exception Unsat + let shift v r v' map = (* value at v' is shifted by r and then added for v *) + match TMap.find_opt v' map with + | None -> map + | Some zmap -> let infl = ZMap.bindings zmap in + let zmap = List.fold_left (fun zmap (r', v') -> + ZMap.add Z.(r' + r) v' zmap) ZMap.empty infl in + TMap.add v zmap map +end -type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] -type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] +(** Quantitative congruence closure on terms *) +module CongruenceClosure (Var : Val) = struct -module Term (Var:Val) = struct - type t = Var.t term [@@deriving eq, ord, hash] - type v_prop = Var.t prop [@@deriving eq, ord, hash] + exception Unsat - let rec show = function - | Addr v -> "&" ^ Var.show v - | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v - | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t - | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" -end + type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] + type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] -(** Quantitative congruence closure *) -module CongruenceClosure (Var:Val) = struct - module T = Term (Var) - module TUF = UnionFind (T) (** Union find on terms *) - module TSet = TUF.ValSet - module ZMap = TUF.ZMap - module TMap = TUF.ValMap - - type part_t = TUF.t [@@deriving eq, ord, hash] - type set_t = TSet.t [@@deriving eq, ord, hash] - type map_t = T.t ZMap.t TMap.t [@@deriving eq, ord, hash] (** Lookup map *) - type min_repr_t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] - - type t = {part: part_t; - set: set_t; - map: map_t; - min_repr: min_repr_t} - [@@deriving eq, ord, hash] + module Term = struct + type t = Var.t term [@@deriving eq, ord, hash] + type v_prop = Var.t prop [@@deriving eq, ord, hash] - let string_of_prop = function - | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 - | Eq (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 - | Neq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 - | Neq (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 + let rec show = function + | Addr v -> "&" ^ Var.show v + | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v + | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t + | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" + end + module T = Term - let show_conj list = List.fold_left - (fun s d -> s ^ "\t" ^ string_of_prop d ^ "\n") "" list + module TUF = UnionFind (T) + module LMap = LookupMap (T) - let print_conj = print_string % show_conj + (** Set of subterms which are present in the current data structure *) + module SSet = struct - let rec subterms_of_term (set,map) t = match t with - | Addr _ -> (TSet.add t set, map) - | Deref (t',z) -> - let set = TSet.add t set in - let map = TUF.map_add (t',z) t map in - (* let arg = TUF.map_set_add (t,z) t' arg in *) - subterms_of_term (set, map) t' + module TSet = struct + include Set.Make(T) + let hash x = 3 + end - let subterms_of_prop (set,map) = function - | Eq (t1,t2,_) - | Neq (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 + type t = TSet.t [@@deriving eq, ord, hash] - let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty,TMap.empty) list + let elements = TSet.elements + let mem = TSet.mem + let add = TSet.add + let fold = TSet.fold + let empty = TSet.empty - let shift v r v' map = (* value at v' is shifted by r and then added for v *) - match TMap.find_opt v' map with - | None -> map - | Some zmap -> let infl = ZMap.bindings zmap in - let zmap = List.fold_left (fun zmap (r', v') -> - ZMap.add Z.(r' + r) v' zmap) ZMap.empty infl in - TMap.add v zmap map + let show_set set = TSet.fold (fun v s -> + s ^ "\t" ^ T.show v ^ "\n") set "" ^ "\n" + let string_of_prop = function + | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 + | Eq (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 + | Neq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 + | Neq (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 - let show_min_rep min_representatives = - let show_one_rep s (state, (rep, z)) = - s ^ "\tState rep: " ^ T.show state ^ - "\n\tMin. Representative: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")\n\n" - in - List.fold_left show_one_rep "" (TMap.bindings min_representatives) - - let print_min_rep = print_string % show_min_rep - - let rec update_min_repr (part, map) min_representatives = function - | [] -> min_representatives - | state::queue -> (* process all outgoing edges in order of ascending edge labels *) - match ZMap.bindings (TMap.find state map) with - | exception Not_found -> (* no outgoing edges *) - update_min_repr (part, map) min_representatives queue - | edges -> - let process_edge (min_representatives, queue) (edge_z, next_term) = - let (next_state, next_z) = TUF.find part next_term in - let (min_term, min_z) = TMap.find state min_representatives in - let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in - match TMap.find_opt next_state min_representatives - with - | None -> - (TMap.add next_state next_min min_representatives, queue @ [next_state]) - | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (TMap.add next_state next_min min_representatives, queue @ [next_state]) - | _ -> (min_representatives, queue) - in - let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges - in update_min_repr (part, map) min_representatives queue + let show_conj list = List.fold_left + (fun s d -> s ^ "\t" ^ string_of_prop d ^ "\n") "" list - (** Uses dijkstra algorithm to update the minimal representatives of - all edges in the queue and if necessary also updates the minimal representatives of - the successor nodes of the automata. - The states in the queu must already have an updated min_repr. - This function visits only the successor nodes of the nodes in queue, not the nodes themselves. - Before visiting the nodes, it sorts the queue by the size of the current min representative. + let print_conj = print_string % show_conj - parameters: + let rec subterms_of_term (set,map) t = match t with + | Addr _ -> (TSet.add t set, map) + | Deref (t',z) -> + let set = TSet.add t set in + let map = LMap.map_add (t',z) t map in + (* let arg = TUF.map_set_add (t,z) t' arg in *) + subterms_of_term (set, map) t' - `(part, map)` represent the union find data tructure and the corresponding lookup map + let subterms_of_prop (set,map) = function + | Eq (t1,t2,_) + | Neq (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class + let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list - `queue` contains the states that need to be processed. - The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. - Therefore the queue is a list of representative terms. *) - let update_min_repr (part, map) min_representatives queue = - (* order queue by size of the current min representative *) - let queue = - List.sort_unique (fun el1 el2 -> TUF.compare_repr (TMap.find el1 min_representatives) (TMap.find el2 min_representatives)) queue - in update_min_repr (part, map) min_representatives queue + let get_atoms set = + (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, + according to our comparison function. Therefore take_while is enough.*) + BatList.take_while (function Addr _ -> true | _ -> false) (elements set) + end - let get_atoms set = - (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, - according to our comparison function. Therefore take_while is enough.*) - BatList.take_while (function Addr _ -> true | _ -> false) (TSet.elements set) + (** TODO add comment. + Minimal representatives map. *) + module MRMap = struct + module TMap = ValMap(T) + + type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] + + let bindings = TMap.bindings + + let find = TMap.find + + let add = TMap.add + + let mem = TMap.mem + + let empty = TMap.empty + + let show_min_rep min_representatives = + let show_one_rep s (state, (rep, z)) = + s ^ "\tState rep: " ^ T.show state ^ + "\n\tMin. Representative: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")\n\n" + in + List.fold_left show_one_rep "" (bindings min_representatives) + + let print_min_rep = print_string % show_min_rep + + let rec update_min_repr (part, map) min_representatives = function + | [] -> min_representatives + | state::queue -> (* process all outgoing edges in order of ascending edge labels *) + match LMap.zmap_bindings (find state map) with + | exception Not_found -> (* no outgoing edges *) + update_min_repr (part, map) min_representatives queue + | edges -> + let process_edge (min_representatives, queue) (edge_z, next_term) = + let (next_state, next_z) = TUF.find part next_term in + let (min_term, min_z) = find state min_representatives in + let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in + match TMap.find_opt next_state min_representatives + with + | None -> + (add next_state next_min min_representatives, queue @ [next_state]) + | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> + (add next_state next_min min_representatives, queue @ [next_state]) + | _ -> (min_representatives, queue) + in + let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges + in update_min_repr (part, map) min_representatives queue + + (** Uses dijkstra algorithm to update the minimal representatives of + all edges in the queue and if necessary also updates the minimal representatives of + the successor nodes of the automata. + The states in the queu must already have an updated min_repr. + This function visits only the successor nodes of the nodes in queue, not the nodes themselves. + Before visiting the nodes, it sorts the queue by the size of the current min representative. + + parameters: + + `(part, map)` represent the union find data tructure and the corresponding lookup map + + `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class + + `queue` contains the states that need to be processed. + The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. + Therefore the queue is a list of representative terms. *) + let update_min_repr (part, map) min_representatives queue = + (* order queue by size of the current min representative *) + let queue = + List.sort_unique (fun el1 el2 -> TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) queue + in update_min_repr (part, map) min_representatives queue + + + (** + Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. + I think it's not used for now, because we compute the minimal representatives incrementally. + *) + let compute_minimal_representatives (part, set, map) = + let atoms = SSet.get_atoms set in + (* process all atoms in increasing order *) + let atoms = + List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find part el1) (TUF.find part el2)) atoms in + let add_atom_to_map (min_representatives, queue) a = + let (rep, offs) = TUF.find part a in + if not (mem rep min_representatives) then + (add rep (a, offs) min_representatives, queue @ [rep]) + else (min_representatives, queue) + in + let (min_representatives, queue) = List.fold_left add_atom_to_map (empty, []) atoms + (* compute the minimal representative of all remaining edges *) + in update_min_repr (part, map) min_representatives queue + + (** + Computes the initial map of minimal representatives. + It maps each element `e` in the set to `(e, 0)`. *) + let initial_minimal_representatives set = + List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) - (** - Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. - I think it's not used for now, because we compute the minimal representatives incrementally. - *) - let compute_minimal_representatives (part, set, map) = - let atoms = get_atoms set in - (* process all atoms in increasing order *) - let atoms = - List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find part el1) (TUF.find part el2)) atoms in - let add_atom_to_map (min_representatives, queue) a = - let (rep, offs) = TUF.find part a in - if not (TMap.mem rep min_representatives) then - (TMap.add rep (a, offs) min_representatives, queue @ [rep]) - else (min_representatives, queue) - in - let (min_representatives, queue) = List.fold_left add_atom_to_map (TMap.empty, []) atoms - (* compute the minimal representative of all remaining edges *) - in update_min_repr (part, map) min_representatives queue + end - (** - Computes the initial map of minimal representatives. - It maps each element `e` in the set to `(e, 0)`. *) - let initial_minimal_representatives set = - List.fold_left (fun map element -> TMap.add element (element, Z.zero) map) TMap.empty (TSet.elements set) + type t = {part: TUF.t; + set: SSet.t; + map: LMap.t; + min_repr: MRMap.t} + [@@deriving eq, ord, hash] let get_transitions (part, map) = - List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ ZMap.bindings imap) else None) (TMap.bindings map) + List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ LMap.zmap_bindings imap) else None) (LMap.bindings map) (* Runtime = O(nrr. of atoms) + O(nr. transitions in the automata) *) let get_normal_form cc = @@ -338,18 +377,18 @@ module CongruenceClosure (Var:Val) = struct if t1 = t2 && Z.(compare z zero) = 0 then None else Some (Eq (t1, t2, z)) in let conjunctions_of_atoms = - let atoms = get_atoms cc.set in + let atoms = SSet.get_atoms cc.set in List.filter_map (fun atom -> let (rep_state, rep_z) = TUF.find cc.part atom in - let (min_state, min_z) = TMap.find rep_state cc.min_repr in + let (min_state, min_z) = MRMap.find rep_state cc.min_repr in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms in let conjunctions_of_transitions = let transitions = get_transitions (cc.part, cc.map) in List.filter_map (fun (z,s,(s',z')) -> - let (min_state, min_z) = TMap.find s cc.min_repr in - let (min_state', min_z') = TMap.find s' cc.min_repr in + let (min_state, min_z) = MRMap.find s cc.min_repr in + let (min_state', min_z') = MRMap.find s' cc.min_repr in normalize_equality (Deref(min_state, Z.(z - min_z)), min_state', Z.(z' - min_z')) ) transitions in BatList.sort_unique (compare_prop Var.compare) (conjunctions_of_atoms @ conjunctions_of_transitions) @@ -366,10 +405,10 @@ module CongruenceClosure (Var:Val) = struct - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class *) let init_cc conj = - let (set, map) = subterms_of_conj conj in - let part = TSet.elements set |> + let (set, map) = SSet.subterms_of_conj conj in + let part = SSet.elements set |> TUF.init in - let min_repr = initial_minimal_representatives set in + let min_repr = MRMap.initial_minimal_representatives set in {part = part; set = set; map = map ; min_repr = min_repr} (** @@ -396,35 +435,35 @@ module CongruenceClosure (Var:Val) = struct else raise Unsat else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) (* update map *) - let map, rest = match TMap.find_opt v1 map, TMap.find_opt v2 map, b with + let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with | None, _, false -> map, rest - | None, Some _, true -> shift v1 Z.(r1-r2-r) v2 map, rest - | Some _, None,false -> shift v2 Z.(r2-r1+r) v1 map, rest + | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) | Some imap1, Some imap2, true -> (* v1 is new root *) (* zmap describes args of Deref *) let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap2) in + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap2) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) + match LMap.zmap_find_opt r' zmap with + | None -> (LMap.zmap_add r' v' zmap, rest) | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in - TMap.add v zmap map, rest + LMap.add v zmap map, rest | Some imap1, Some imap2, false -> (* v2 is new root *) let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (ZMap.bindings imap1) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match ZMap.find_opt r' zmap with - | None -> (ZMap.add r' v' zmap, rest) + match LMap.zmap_find_opt r' zmap with + | None -> (LMap.zmap_add r' v' zmap, rest) | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in - TMap.add v zmap map, rest + LMap.add v zmap map, rest in (* update min_repr *) - let min_v1, min_v2 = TMap.find v1 min_repr, TMap.find v2 min_repr in + let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in (* 'changed' is true if the new_min is different thatn the old min *) let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in let (_, rep_v) = TUF.find part new_min in - let min_repr = if changed then TMap.add v (new_min, rep_v) min_repr else min_repr in + let min_repr = if changed then LMap.add v (new_min, rep_v) min_repr else min_repr in let queue = if changed then (v :: queue) else queue in closure (part, map, min_repr) queue rest ) @@ -443,7 +482,7 @@ module CongruenceClosure (Var:Val) = struct *) let closure cc conjs = let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in - let min_repr = update_min_repr (part, map) min_repr queue in + let min_repr = MRMap.update_min_repr (part, map) min_repr queue in {part = part; set = cc.set; map = map; min_repr = min_repr} let fold_left2 f acc l1 l2 = @@ -479,23 +518,6 @@ module CongruenceClosure (Var:Val) = struct | exception Unsat -> None | x -> Some x - let print_eq cmap = - let clist = TMap.bindings cmap in - List.iter (fun (v,zmap) -> - let ilist = ZMap.bindings zmap in - List.iter (fun (r,set) -> - let list = TSet.elements set in - List.iter (fun v' -> - if T.compare v v' = 0 then () else ( - print_string "\t"; - print_string (T.show v'); - print_string " = "; - (if Z.equal r Z.zero then () else - Z.print r; - print_string " + "); - print_string (T.show v); - print_string "\n")) list) ilist) clist - (** Add a term to the data structure Returns (reference variable, offset), updated (part, set, map, min_repr), @@ -504,21 +526,21 @@ module CongruenceClosure (Var:Val) = struct `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. Therefore it contains either one or zero elements. *) let rec insert_no_min_repr cc t = - if TSet.mem t cc.set then + if SSet.mem t cc.set then TUF.find cc.part t, cc,[] - else let set = TSet.add t cc.set in + else let set = SSet.add t cc.set in match t with - | Addr a -> let part = TMap.add t (ref (t, Z.zero),1) cc.part in - let min_repr = TMap.add t (t, Z.zero) cc.min_repr in + | Addr a -> let part = LMap.add t (ref (t, Z.zero),1) cc.part in + let min_repr = LMap.add t (t, Z.zero) cc.min_repr in (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in - match TUF.map_find_opt (v, Z.(r + z)) cc.map with + match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> TUF.find cc.part v', cc, queue (* TODO don't we need a union here? *) - | None -> let map = TUF.map_add (v, Z.(r + z)) t cc.map in - let part = TMap.add t (ref (t, Z.zero),1) cc.part in - let min_repr = TMap.add t (t, Z.zero) cc.min_repr in + | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in + let part = LMap.add t (ref (t, Z.zero),1) cc.part in + let min_repr = LMap.add t (t, Z.zero) cc.min_repr in (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, queue (** Add a term to the data structure @@ -527,16 +549,16 @@ module CongruenceClosure (Var:Val) = struct let insert cc t = let v, cc, queue = insert_no_min_repr cc t in (* the queue has at most one element, so there is no need to sort it *) - let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in + let min_repr = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} (** Add all terms in a specific set to the data structure Returns updated (part, set, map, min_repr) *) - let insert_set cc t_set = (* SAFE VERSION but less efficient: TSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) - let cc, queue = TSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in + let insert_set cc t_set = (* SAFE VERSION but less efficient: SSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) + let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr = update_min_repr (cc.part, cc.map) cc.min_repr queue in + let min_repr = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} @@ -544,7 +566,7 @@ module CongruenceClosure (Var:Val) = struct Throws "Unsat" if a contradiction is found. *) let meet_conjs cc conjs = - let cc = insert_set cc (fst (subterms_of_conj conjs)) in + let cc = insert_set cc (fst (SSet.subterms_of_conj conjs)) in closure cc (fst (split conjs)) (** @@ -577,51 +599,3 @@ module CongruenceClosure (Var:Val) = struct cc end - - -module QFA (Var:Val) = -struct - module CC = CongruenceClosure(Var) - include CC - - type state = T.t (** The state is represented by the representative -> or by the minimal term. *) - - type initial_states = Var.t -> (state * Z.t) (** Maps each variable to its initial state. *) - - type transitions = Z.t -> state -> (Z.t * state) option - - (* let get_vars = List.filter_map (function - | Addr var -> Some var - | _ -> None) % TSet.elements *) - - (** Returns the initial state of the QFA for a certain variable - - Parameters: Union Find Map and variable for which we want to know the initial state *) - let get_initial_state part var = TUF.find_opt part (Addr var) - - (* pag. 8 before proposition 1 *) - (** Returns the transition of the QFA for a certain Z, starting from a certain state - - Parameters: - - - Lookup Map - - - Z and State for which we want to know the next state *) - let transition_qfa (part, map) z state = match TUF.map_find_opt (state, z) map with - | Some term -> TUF.find_opt part term - | None -> None - - - (* Question: is this not the same as find_opt?? I think it is *) - (** Returns the state we get from the automata after it has read the term. - - It's useless. It's the same as TUF.find_opt. But less efficient. - - Parameters: Union Find Map and term for which we want to know the final state *) - let rec get_state (part, map) = function - | Addr v -> get_initial_state part v - | Deref (t, z) -> match get_state (part, map) t with - | None -> None - | Some (next_state, z1) -> transition_qfa map (Z.(z + z1)) next_state - -end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index dd05936b65..7ec7a1261c 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -23,7 +23,7 @@ module D : Lattice.S = struct (** Convert to string *) let show x = match x with | None -> "⊥" - | Some x -> show_conj (get_normal_form x) + | Some x -> SSet.show_conj (get_normal_form x) let show_all = function @@ -31,11 +31,11 @@ module D : Lattice.S = struct | Some x -> "Union Find partition:\n" ^ (TUF.show_uf x.part) ^ "\nSubterm set:\n" - ^ (TUF.show_set x.set) + ^ (SSet.show_set x.set) ^ "\nLookup map/transitions:\n" - ^ (TUF.show_map x.map) + ^ (LMap.show_map x.map) ^ "\nMinimal representatives:\n" - ^ (show_min_rep x.min_repr) + ^ (MRMap.show_min_rep x.min_repr) include Printable.SimpleShow(struct type t = domain let show = show end) @@ -49,7 +49,7 @@ module D : Lattice.S = struct let compare x y = 0 (* How to compare if there is no total order? *) - let empty () = Some {part = TMap.empty; set = TSet.empty; map = TMap.empty; min_repr = TMap.empty} + let empty () = Some {part = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty} let init () = init_congruence [] From 2b850bb8e96c8dc0d323ea167443684ddf2f8c7b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 28 Mar 2024 10:53:54 +0100 Subject: [PATCH 017/323] some more refactoring --- src/cdomains/congruenceClosure.ml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6607301595..18fb872bf9 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -233,17 +233,6 @@ module CongruenceClosure (Var : Val) = struct let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ "\n") set "" ^ "\n" - let string_of_prop = function - | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 - | Eq (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 - | Neq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 - | Neq (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 - - let show_conj list = List.fold_left - (fun s d -> s ^ "\t" ^ string_of_prop d ^ "\n") "" list - - let print_conj = print_string % show_conj - let rec subterms_of_term (set,map) t = match t with | Addr _ -> (TSet.add t set, map) | Deref (t',z) -> @@ -368,6 +357,17 @@ module CongruenceClosure (Var : Val) = struct min_repr: MRMap.t} [@@deriving eq, ord, hash] + let string_of_prop = function + | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 + | Eq (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 + | Neq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 + | Neq (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 + + let show_conj list = List.fold_left + (fun s d -> s ^ "\t" ^ string_of_prop d ^ "\n") "" list + + let print_conj = print_string % show_conj + let get_transitions (part, map) = List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ LMap.zmap_bindings imap) else None) (LMap.bindings map) From d818d44fee969db88a8d0bd1c780a00a60fe2e4a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 28 Mar 2024 10:54:07 +0100 Subject: [PATCH 018/323] some more refactoring --- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 7ec7a1261c..386bcf4453 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -23,7 +23,7 @@ module D : Lattice.S = struct (** Convert to string *) let show x = match x with | None -> "⊥" - | Some x -> SSet.show_conj (get_normal_form x) + | Some x -> show_conj (get_normal_form x) let show_all = function From a7e61f2c27be042d3d4e5f18c5c84c5d022c283f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 28 Mar 2024 11:53:05 +0100 Subject: [PATCH 019/323] remove entries of map and min_repr when they are not representatives any more --- src/cdomains/congruenceClosure.ml | 98 +++++++++++++++++-------------- 1 file changed, 54 insertions(+), 44 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 18fb872bf9..5592636d1b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -15,7 +15,6 @@ module ValMap(Val:Val) = struct let hash x y = 3 end - (** Quantitative union find *) module UnionFind (Val: Val) = struct module ValMap = ValMap(Val) @@ -60,6 +59,14 @@ module UnionFind (Val: Val) = struct if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") else if is_root uf v' then + (* + let _ = print_string (Val.show v) in + let _ = print_string " = " in + let _ = print_string (string_of_int r') in + let _ = print_string "+" in + let _ = print_string (Val.show v') in + let _ = print_string "\n" in + *) (v',r') else let rec search v list = match ValMap.find_opt v uf with @@ -74,14 +81,16 @@ module UnionFind (Val: Val) = struct else search v' (refv :: list) in let v1,r = search v' [refv] in + (* + let _ = print_string (Val.show v) in + let _ = print_string " = " in + let _ = print_string (string_of_int r) in + let _ = print_string "+" in + let _ = print_string (Val.show v1) in + let _ = print_string "\n" in + *) v1,r - (** - For a variable t it returns the reference variable v and the offset r. - This find performs path compression. - - Returns "None" if t is not present in the data structure. - *) let find_opt uf v = match find uf v with | exception (UnknownValue _) | exception (InvalidUnionFind _) -> None @@ -133,7 +142,6 @@ module UnionFind (Val: Val) = struct ^ "\n") "" (get_eq_classes uf) ^ "\n" end - module LookupMap (T: Val) = struct module TMap = ValMap(T) @@ -146,6 +154,7 @@ module LookupMap (T: Val) = struct let bindings = TMap.bindings let add = TMap.add + let remove = TMap.remove let empty = TMap.empty let find_opt = TMap.find_opt let find = TMap.find @@ -154,16 +163,16 @@ module LookupMap (T: Val) = struct let zmap_add = ZMap.add let zmap_find_opt = ZMap.find_opt - let map_find_opt (v,r) map = match TMap.find_opt v map with + let map_find_opt (v,r) map = match find_opt v map with | None -> None - | Some zmap -> (match ZMap.find_opt r zmap with + | Some zmap -> (match zmap_find_opt r zmap with | None -> None | Some v -> Some v ) - let map_add (v,r) v' map = match TMap.find_opt v map with - | None -> TMap.add v (ZMap.add r v' ZMap.empty) map - | Some zmap -> TMap.add v (ZMap.add r v' zmap) map + let map_add (v,r) v' map = match find_opt v map with + | None -> add v (zmap_add r v' ZMap.empty) map + | Some zmap -> add v (zmap_add r v' zmap) map let show_map map = List.fold_left @@ -172,44 +181,47 @@ module LookupMap (T: Val) = struct List.fold_left (fun s (r, v) -> s ^ "\t" ^ Z.to_string r ^ ": " ^ T.show v ^ "; ") - "" (ZMap.bindings zmap) ^ "\n") - "" (TMap.bindings map) + "" (zmap_bindings zmap) ^ "\n") + "" (bindings map) let print_map = print_string % show_map let clone map = - TMap.bindings map |> - List.fold_left (fun map (v,node) -> TMap.add v node map) (TMap.empty) + bindings map |> + List.fold_left (fun map (v,node) -> add v node map) (empty) - let shift v r v' map = (* value at v' is shifted by r and then added for v *) - match TMap.find_opt v' map with + (** The value at v' is shifted by r and then added for v. + The old entry for v' is removed. *) + let shift v r v' map = + match find_opt v' map with | None -> map - | Some zmap -> let infl = ZMap.bindings zmap in + | Some zmap -> let infl = zmap_bindings zmap in let zmap = List.fold_left (fun zmap (r', v') -> - ZMap.add Z.(r' + r) v' zmap) ZMap.empty infl in - TMap.add v zmap map + zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in + remove v' (add v zmap map) end -(** Quantitative congruence closure on terms *) -module CongruenceClosure (Var : Val) = struct +exception Unsat - exception Unsat +type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] +type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] - type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] - type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] +module Term(Var:Val) = struct + type t = Var.t term [@@deriving eq, ord, hash] + type v_prop = Var.t prop [@@deriving eq, ord, hash] - module Term = struct - type t = Var.t term [@@deriving eq, ord, hash] - type v_prop = Var.t prop [@@deriving eq, ord, hash] + let rec show = function + | Addr v -> "&" ^ Var.show v + | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v + | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t + | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" +end + +(** Quantitative congruence closure on terms *) +module CongruenceClosure (Var : Val) = struct - let rec show = function - | Addr v -> "&" ^ Var.show v - | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v - | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t - | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" - end - module T = Term + module T = Term(Var) module TUF = UnionFind (T) module LMap = LookupMap (T) @@ -261,13 +273,10 @@ module CongruenceClosure (Var : Val) = struct type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings - let find = TMap.find - let add = TMap.add - + let remove = TMap.remove let mem = TMap.mem - let empty = TMap.empty let show_min_rep min_representatives = @@ -448,7 +457,7 @@ module CongruenceClosure (Var : Val) = struct match LMap.zmap_find_opt r' zmap with | None -> (LMap.zmap_add r' v' zmap, rest) | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in - LMap.add v zmap map, rest + LMap.remove v2 (LMap.add v zmap map), rest | Some imap1, Some imap2, false -> (* v2 is new root *) let r0 = Z.(r1-r2-r) in let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in @@ -456,14 +465,15 @@ module CongruenceClosure (Var : Val) = struct match LMap.zmap_find_opt r' zmap with | None -> (LMap.zmap_add r' v' zmap, rest) | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in - LMap.add v zmap map, rest + LMap.remove v1 (LMap.add v zmap map), rest in (* update min_repr *) let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in (* 'changed' is true if the new_min is different thatn the old min *) let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in let (_, rep_v) = TUF.find part new_min in - let min_repr = if changed then LMap.add v (new_min, rep_v) min_repr else min_repr in + let removed_v = if b then v2 else v1 in + let min_repr = MRMap.remove removed_v (if changed then MRMap.add v (new_min, rep_v) min_repr else min_repr) in let queue = if changed then (v :: queue) else queue in closure (part, map, min_repr) queue rest ) From 88bfff2d6c78f380c78c2cffde1a1f2c6f7f0848 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 28 Mar 2024 17:12:53 +0100 Subject: [PATCH 020/323] started implementing removing terms from the data structure --- src/cdomains/congruenceClosure.ml | 189 +++++++++++++++++++----------- 1 file changed, 120 insertions(+), 69 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 5592636d1b..d0ffe405f4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -24,6 +24,8 @@ module UnionFind (Val: Val) = struct (** (value * offset) ref * size of equivalence class *) type 'v node = ('v * Z.t) ref * int [@@deriving eq, ord, hash] + (** Maps each value to its children in the union find data structure. + Necessary in order to be able to delete values. *) type t = Val.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) exception UnknownValue of Val.t @@ -52,21 +54,14 @@ module UnionFind (Val: Val) = struct Throws "Unknown value" if t is not present in the data structure. *) - let find uf v = match ValMap.find_opt v uf with + let find uf v = + match ValMap.find_opt v uf with | None -> raise (UnknownValue v) | Some (refv,_) -> let (v',r') = !refv in if Val.compare v' v = 0 then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") else if is_root uf v' then - (* - let _ = print_string (Val.show v) in - let _ = print_string " = " in - let _ = print_string (string_of_int r') in - let _ = print_string "+" in - let _ = print_string (Val.show v') in - let _ = print_string "\n" in - *) (v',r') else let rec search v list = match ValMap.find_opt v uf with @@ -75,21 +70,11 @@ module UnionFind (Val: Val) = struct if is_root uf v' then let _ = List.fold_left (fun r0 refv -> let (_,r'') = !refv in - let _ = refv := (v,Z.(r0+r'')) - in Z.(r0+r'')) r' list + let _ = refv := (v',Z.(r0+r'')) + in Z.(r0+r'')) Z.zero (refv::list) in (v',r') else search v' (refv :: list) - in - let v1,r = search v' [refv] in - (* - let _ = print_string (Val.show v) in - let _ = print_string " = " in - let _ = print_string (string_of_int r) in - let _ = print_string "+" in - let _ = print_string (Val.show v1) in - let _ = print_string "\n" in - *) - v1,r + in search v' [refv] let find_opt uf v = match find uf v with | exception (UnknownValue _) @@ -136,12 +121,14 @@ module UnionFind (Val: Val) = struct (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> - s ^ List.fold_left (fun s (v, _) -> - let (refv, size) = ValMap.find v uf in + s ^ List.fold_left (fun s (v, (refv, size)) -> s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" end + + + module LookupMap (T: Val) = struct module TMap = ValMap(T) @@ -199,6 +186,11 @@ module LookupMap (T: Val) = struct let zmap = List.fold_left (fun zmap (r', v') -> zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in remove v' (add v zmap map) + + let successors v map = + match find_opt v map with + | None -> [] + | Some zmap -> zmap_bindings zmap end exception Unsat @@ -245,10 +237,15 @@ module CongruenceClosure (Var : Val) = struct let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ "\n") set "" ^ "\n" + (** Returns true if the first parameter is a subterm of the second one. *) + let rec is_subterm st term = T.equal st term || match term with + | Deref (t, _) -> is_subterm st t + | _ -> false + let rec subterms_of_term (set,map) t = match t with - | Addr _ -> (TSet.add t set, map) + | Addr _ -> (add t set, map) | Deref (t',z) -> - let set = TSet.add t set in + let set = add t set in let map = LMap.map_add (t',z) t map in (* let arg = TUF.map_set_add (t,z) t' arg in *) subterms_of_term (set, map) t' @@ -263,6 +260,49 @@ module CongruenceClosure (Var : Val) = struct (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, according to our comparison function. Therefore take_while is enough.*) BatList.take_while (function Addr _ -> true | _ -> false) (elements set) + + (* remove varibales *) + (** Returns new_set, removed_terms_set, map_of_children, map_of_predecessors *) + let remove_terms_containing_variable (part, set, map) var = + (** Adds `value` to the set that is in the `map` with key `term` *) + let add_to_map_of_children value map term = + if T.equal term value then map else + match TUF.ValMap.find_opt term map with + | None -> TUF.ValMap.add term [value] map + | Some list -> TUF.ValMap.add term (value::list) map in + let add_to_map_of_predecessors value map (z, term) = + match TUF.ValMap.find_opt term map with + | None -> TUF.ValMap.add term [(z, value)] map + | Some list -> TUF.ValMap.add term ((z, value)::list) map in + let add_to_result el (new_set, removed_terms_set, map_of_children, map_of_predecessors) = + let new_set, removed_terms_set = if is_subterm var el then new_set, add el removed_terms_set else add el new_set, removed_terms_set in + let (uf_parent_ref, _) = TUF.ValMap.find el part in + let map_of_children = add_to_map_of_children el map_of_children (fst !uf_parent_ref) in + let successors = LMap.successors el map in + let map_of_predecessors = List.fold_left (add_to_map_of_predecessors el) map_of_predecessors successors in + (new_set, removed_terms_set, map_of_children, map_of_predecessors) in + TSet.fold add_to_result set (TSet.empty, TSet.empty, TUF.ValMap.empty, TUF.ValMap.empty) + + let show_map_of_children map_of_children = + List.fold_left + (fun s (v, list) -> + s ^ T.show v ^ "\t:\n" ^ + List.fold_left + (fun s v -> + s ^ T.show v ^ "; ") + "\t" list ^ "\n") + "" (TUF.ValMap.bindings map_of_children) + + let show_map_of_predecessors map_of_predecessors = List.fold_left + (fun s (v, list) -> + s ^ T.show v ^ "\t:\n" ^ + List.fold_left + (fun s (r, v) -> + s ^ Z.to_string r ^ " " ^T.show v ^ "; ") + "\t" list ^ "\n") + "" (TUF.ValMap.bindings map_of_predecessors) + + end (** TODO add comment. @@ -298,7 +338,7 @@ module CongruenceClosure (Var : Val) = struct let process_edge (min_representatives, queue) (edge_z, next_term) = let (next_state, next_z) = TUF.find part next_term in let (min_term, min_z) = find state min_representatives in - let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in + let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in (**TODO Why next_z. Is next term really exactly equl to nextx min? Probably?*) match TMap.find_opt next_state min_representatives with | None -> @@ -326,10 +366,10 @@ module CongruenceClosure (Var : Val) = struct `queue` contains the states that need to be processed. The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. Therefore the queue is a list of representative terms. *) - let update_min_repr (part, map) min_representatives queue = + let update_min_repr (part, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = - List.sort_unique (fun el1 el2 -> TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) queue + List.sort_unique (fun el1 el2 -> print_string (T.show el2); print_string (T.show (fst (find el2 min_representatives))); TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root part) queue) in update_min_repr (part, map) min_representatives queue @@ -436,46 +476,47 @@ module CongruenceClosure (Var : Val) = struct *) let rec closure (part, map, min_repr) queue = function | [] -> (part, map, queue, min_repr) - | (t1, t2, r)::rest -> (match TUF.find part t1, TUF.find part t2 with - | (v1,r1), (v2,r2) -> - if T.compare v1 v2 = 0 then - (* t1 and t2 are in the same equivalence class *) - if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest - else raise Unsat - else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) - (* update map *) - let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with - | None, _, false -> map, rest - | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest - | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest - | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) - | Some imap1, Some imap2, true -> (* v1 is new root *) - (* zmap describes args of Deref *) - let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap2) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match LMap.zmap_find_opt r' zmap with - | None -> (LMap.zmap_add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in - LMap.remove v2 (LMap.add v zmap map), rest - | Some imap1, Some imap2, false -> (* v2 is new root *) - let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match LMap.zmap_find_opt r' zmap with - | None -> (LMap.zmap_add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in - LMap.remove v1 (LMap.add v zmap map), rest - in - (* update min_repr *) - let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in - (* 'changed' is true if the new_min is different thatn the old min *) - let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in - let (_, rep_v) = TUF.find part new_min in - let removed_v = if b then v2 else v1 in - let min_repr = MRMap.remove removed_v (if changed then MRMap.add v (new_min, rep_v) min_repr else min_repr) in - let queue = if changed then (v :: queue) else queue in - closure (part, map, min_repr) queue rest + | (t1, t2, r)::rest -> + (match TUF.find part t1, TUF.find part t2 with + | (v1,r1), (v2,r2) -> + if T.compare v1 v2 = 0 then + (* t1 and t2 are in the same equivalence class *) + if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest + else raise Unsat + else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) + (* update map *) + let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with + | None, _, false -> map, rest + | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest + | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match LMap.zmap_find_opt r' zmap with + | None -> (LMap.zmap_add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in + LMap.remove v2 (LMap.add v zmap map), rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + match LMap.zmap_find_opt r' zmap with + | None -> (LMap.zmap_add r' v' zmap, rest) + | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in + LMap.remove v1 (LMap.add v zmap map), rest + in + (* update min_repr *) + let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in + (* 'changed' is true if the new_min is different thatn the old min *) + let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in + let (_, rep_v) = TUF.find part new_min in + let removed_v = if b then v2 else v1 in + let min_repr = MRMap.remove removed_v (if changed then MRMap.add v (new_min, rep_v) min_repr else min_repr) in + let queue = if changed then (v :: queue) else queue in + closure (part, map, min_repr) queue rest ) (** @@ -608,4 +649,14 @@ module CongruenceClosure (Var : Val) = struct let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in cc + + (** Remove terms from the data structure. + It removes all terms for which "var" is a subterm from the data structure, + while maintaining all equalities about variables that are not being removed. + let remove_terms_containing_variable cc var = + (* first find all terms that need to be removed *) + let new_set, removed_terms_set, map_of_children, map_of_predecessors = + SSet.remove_terms_containing_variable (cc.part, cc.set, cc.map) + in () + *) end From 2a571e7c3be26fab9c019b2c07db9b342855768b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 2 Apr 2024 13:54:39 +0200 Subject: [PATCH 021/323] implemented removing variables from the union find tree --- src/cdomains/congruenceClosure.ml | 125 ++++++++++++++++-- src/cdomains/weaklyRelationalPointerDomain.ml | 1 + 2 files changed, 118 insertions(+), 8 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index d0ffe405f4..07c844b84e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -44,10 +44,30 @@ module UnionFind (Val: Val) = struct | None -> raise (UnknownValue v) | Some (refv, _) -> Val.compare v (fst !refv) = 0 + let parent uf v = + let (refv, _) = ValMap.find v uf in + !refv + + let parent_offset uf v = + snd (parent uf v) + + let subtree_size uf v = snd (ValMap.find v uf) + + let modify_parent uf v (t, offset) = + let (refv, _) = ValMap.find v uf in + refv := (t, offset) + (** Returns true if each equivalence class in the data structure contains only one element, i.e. every node is a root. *) let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst !refv) = 0) (ValMap.bindings uf) + (** Throws "Unknown value" if v is not present in the data structure. *) + let show_uf_ugly uf = + List.fold_left (fun s (v, (refv, size)) -> + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ + "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^ "\n") + "" (ValMap.bindings uf) ^ "\n" + (** For a variable t it returns the reference variable v and the offset r. This find performs path compression. @@ -81,6 +101,22 @@ module UnionFind (Val: Val) = struct | exception (InvalidUnionFind _) -> None | res -> Some res + + (** + For a variable t it returns the reference variable v and the offset r. + This find DOES NOT perform path compression. + + Throws "Unknown value" if t is not present in the data structure. + *) + let rec find_no_pc uf v = + match ValMap.find_opt v uf with + | None -> raise (UnknownValue v) + | Some (refv,_) -> let (v',r') = !refv in + if Val.compare v' v = 0 then + if Z.equal r' Z.zero then (v',r') + else raise (InvalidUnionFind "non-zero self-distance!") + else find_no_pc uf v' + let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare let compare_repr_v (v1, _) (v2, _) = Val.compare v1 v2 @@ -124,6 +160,17 @@ module UnionFind (Val: Val) = struct s ^ List.fold_left (fun s (v, (refv, size)) -> s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" + + (** Modifies the size of the equivalence class for the current element and + for the while path to the root of this element. + + `modification` is the function to apply to the sizes. *) + let rec change_size t part modification = + let (ref_r, old_size) = ValMap.find t part in + let part = ValMap.add t (ref_r, modification old_size) part in + let parent = fst(!ref_r) in + if parent = t then part else change_size parent part modification + end @@ -261,15 +308,17 @@ module CongruenceClosure (Var : Val) = struct according to our comparison function. Therefore take_while is enough.*) BatList.take_while (function Addr _ -> true | _ -> false) (elements set) + + let add_to_map_of_children value map term = + if T.equal term value then map else + match TUF.ValMap.find_opt term map with + | None -> TUF.ValMap.add term [value] map + | Some list -> TUF.ValMap.add term (value::list) map + (* remove varibales *) - (** Returns new_set, removed_terms_set, map_of_children, map_of_predecessors *) + (** Returns new_set, new_map, removed_terms_set, map_of_children, map_of_predecessors *) let remove_terms_containing_variable (part, set, map) var = (** Adds `value` to the set that is in the `map` with key `term` *) - let add_to_map_of_children value map term = - if T.equal term value then map else - match TUF.ValMap.find_opt term map with - | None -> TUF.ValMap.add term [value] map - | Some list -> TUF.ValMap.add term (value::list) map in let add_to_map_of_predecessors value map (z, term) = match TUF.ValMap.find_opt term map with | None -> TUF.ValMap.add term [(z, value)] map @@ -279,7 +328,7 @@ module CongruenceClosure (Var : Val) = struct let (uf_parent_ref, _) = TUF.ValMap.find el part in let map_of_children = add_to_map_of_children el map_of_children (fst !uf_parent_ref) in let successors = LMap.successors el map in - let map_of_predecessors = List.fold_left (add_to_map_of_predecessors el) map_of_predecessors successors in + let map_of_predecessors = List.fold_left (add_to_map_of_predecessors el) map_of_predecessors successors in (*instead of this just remove from rhs*) (new_set, removed_terms_set, map_of_children, map_of_predecessors) in TSet.fold add_to_result set (TSet.empty, TSet.empty, TUF.ValMap.empty, TUF.ValMap.empty) @@ -303,6 +352,65 @@ module CongruenceClosure (Var : Val) = struct "" (TUF.ValMap.bindings map_of_predecessors) + + (* remove variables from union find *) + (** Returns part, new_parents_map, new_map_of_children *) + let remove_terms_containing_variable_from_uf part removed_terms_set map_of_children = + let find_not_removed_element set = match List.find (fun el -> not (TSet.mem el removed_terms_set)) set with + | exception Not_found -> List.first set + | t -> t + in + let remove_term t (part, new_parents_map, map_of_children) = + match LMap.find_opt t map_of_children with + | None -> + (* t has no childrem, so we can safely delete the element from the data structure *) + (* we just need to update the size on the whole path from here to the root *) + (* we know that after a find operation the parent of t is a root, because of path compression. *) + let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (fst(TUF.parent part t)) new_parents_map in + (TUF.ValMap.remove t (TUF.change_size t part ((-) 1)), new_parents_map, map_of_children) + | Some children -> + let map_of_children = LMap.remove t map_of_children in + if TUF.is_root part t then + (* t is a root and it has some children: + 1. choose new root. + The new_root is in any case one of the children of the old root. + If possible, we choose one of the children that is not going to be deleted. *) + let new_root = find_not_removed_element children in + let remaining_children = List.remove children new_root in + let offset_new_root = TUF.parent_offset part new_root in + (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) + let new_size, map_of_children = List.fold + (fun (total_size, map_of_children) child -> + (* update parent and offset *) + let _ = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in + total_size + TUF.subtree_size part child, add_to_map_of_children child map_of_children new_root + ) (0, map_of_children) remaining_children in + (* Update new root -> set itself as new parent. *) + let _ = TUF.modify_parent part new_root (new_root, Z.zero) in + (* update size of equivalence class *) + let part = TUF.change_size new_root part ((+) new_size) in + (TUF.ValMap.remove t part, LMap.add t new_root new_parents_map, map_of_children) + else + (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) + let (new_root, new_offset) = TUF.parent part t in + let remaining_children = List.remove children new_root in + (* update all parents of the children of t *) + let map_of_children = List.fold + (fun map_of_children child -> + (* update parent and offset *) + TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t + new_offset)); + add_to_map_of_children child map_of_children new_root + ) map_of_children remaining_children in + (* update size of equivalence class *) + let part = TUF.change_size new_root part ((-) 1) in + (TUF.ValMap.remove t part, LMap.add t new_root new_parents_map, map_of_children) + in TSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) + + let show_new_parents_map new_parents_map = List.fold_left + (fun s (v1, v2) -> + s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ "\n") + "" (LMap.bindings new_parents_map) + end (** TODO add comment. @@ -656,7 +764,8 @@ module CongruenceClosure (Var : Val) = struct let remove_terms_containing_variable cc var = (* first find all terms that need to be removed *) let new_set, removed_terms_set, map_of_children, map_of_predecessors = - SSet.remove_terms_containing_variable (cc.part, cc.set, cc.map) + SSet.remove_terms_containing_variable (cc.part, cc.set, cc.map) var + in let part, new_parents_map, map_of_children = TUF.remove_terms_containing_variable cc.part removed_terms_set map_of_children var in () *) end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 386bcf4453..237b05de4e 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -26,6 +26,7 @@ module D : Lattice.S = struct | Some x -> show_conj (get_normal_form x) + let show_all = function | None -> "⊥\n" | Some x -> "Union Find partition:\n" ^ From 4c107b8a5910bbb7c52b4393e531af472f0676be Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 3 Apr 2024 13:32:47 +0200 Subject: [PATCH 022/323] implemented removing variables from the lookup map --- src/cdomains/congruenceClosure.ml | 168 +++++++++++++++++++----------- 1 file changed, 109 insertions(+), 59 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 07c844b84e..7acf9cbce1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -15,6 +15,11 @@ module ValMap(Val:Val) = struct let hash x y = 3 end +module ValSet(Val:Val) = struct + include Set.Make(Val) + let hash x = 3 +end + (** Quantitative union find *) module UnionFind (Val: Val) = struct module ValMap = ValMap(Val) @@ -40,7 +45,7 @@ module UnionFind (Val: Val) = struct (** Returns true if v is the representative value of its equivalence class Throws "Unknown value" if v is not present in the data structure. *) - let is_root cc v = match ValMap.find_opt v cc with + let is_root uf v = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) | Some (refv, _) -> Val.compare v (fst !refv) = 0 @@ -173,18 +178,16 @@ module UnionFind (Val: Val) = struct end - - - module LookupMap (T: Val) = struct module TMap = ValMap(T) + module TSet = ValSet(T) module ZMap = struct include Map.Make(Z) let hash x y = 3 end - type t = T.t ZMap.t TMap.t [@@deriving eq, ord, hash] + type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings let add = TMap.add @@ -194,19 +197,27 @@ module LookupMap (T: Val) = struct let find = TMap.find let zmap_bindings = ZMap.bindings - let zmap_add = ZMap.add + let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) + let zmap_find_opt = ZMap.find_opt + let set_any = TSet.any + + let zmap_add x y m = match zmap_find_opt x m with + | None -> ZMap.add x y m + | Some set -> ZMap.add x (TSet.union y set) m + let map_find_opt (v,r) map = match find_opt v map with | None -> None | Some zmap -> (match zmap_find_opt r zmap with | None -> None - | Some v -> Some v + | Some v -> Some (TSet.any v) ) - let map_add (v,r) v' map = match find_opt v map with - | None -> add v (zmap_add r v' ZMap.empty) map - | Some zmap -> add v (zmap_add r v' zmap) map + let map_add (v,r) v' map = let zmap =match find_opt v map with + | None -> ZMap.empty + | Some zmap ->zmap + in add v (zmap_add r (TSet.singleton v') zmap) map let show_map map = List.fold_left @@ -214,7 +225,9 @@ module LookupMap (T: Val) = struct s ^ T.show v ^ "\t:\n" ^ List.fold_left (fun s (r, v) -> - s ^ "\t" ^ Z.to_string r ^ ": " ^ T.show v ^ "; ") + s ^ "\t" ^ Z.to_string r ^ ": " ^ List.fold_left + (fun s k -> s ^ T.show k ^ ";") + "" (TSet.elements v) ^ "; ") "" (zmap_bindings zmap) ^ "\n") "" (bindings map) @@ -237,7 +250,19 @@ module LookupMap (T: Val) = struct let successors v map = match find_opt v map with | None -> [] - | Some zmap -> zmap_bindings zmap + | Some zmap -> zmap_bindings_one_successor zmap + + let outgoing_transitions state map = + match find_opt state map with + | None -> [] + | Some zmap -> zmap_bindings_one_successor zmap + + let filter_if map p = + TMap.filter_map (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ t_set -> let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) zmap + in if ZMap.is_empty zmap then None else Some zmap) map end exception Unsat @@ -267,12 +292,7 @@ module CongruenceClosure (Var : Val) = struct (** Set of subterms which are present in the current data structure *) module SSet = struct - - module TSet = struct - include Set.Make(T) - let hash x = 3 - end - + module TSet = ValSet(T) type t = TSet.t [@@deriving eq, ord, hash] let elements = TSet.elements @@ -294,7 +314,6 @@ module CongruenceClosure (Var : Val) = struct | Deref (t',z) -> let set = add t set in let map = LMap.map_add (t',z) t map in - (* let arg = TUF.map_set_add (t,z) t' arg in *) subterms_of_term (set, map) t' let subterms_of_prop (set,map) = function @@ -316,21 +335,15 @@ module CongruenceClosure (Var : Val) = struct | Some list -> TUF.ValMap.add term (value::list) map (* remove varibales *) - (** Returns new_set, new_map, removed_terms_set, map_of_children, map_of_predecessors *) - let remove_terms_containing_variable (part, set, map) var = + (** Returns new_set, removed_terms_set, map_of_children *) + let remove_terms_containing_variable (part, set) var = (** Adds `value` to the set that is in the `map` with key `term` *) - let add_to_map_of_predecessors value map (z, term) = - match TUF.ValMap.find_opt term map with - | None -> TUF.ValMap.add term [(z, value)] map - | Some list -> TUF.ValMap.add term ((z, value)::list) map in - let add_to_result el (new_set, removed_terms_set, map_of_children, map_of_predecessors) = + let add_to_result el (new_set, removed_terms_set, map_of_children) = let new_set, removed_terms_set = if is_subterm var el then new_set, add el removed_terms_set else add el new_set, removed_terms_set in let (uf_parent_ref, _) = TUF.ValMap.find el part in let map_of_children = add_to_map_of_children el map_of_children (fst !uf_parent_ref) in - let successors = LMap.successors el map in - let map_of_predecessors = List.fold_left (add_to_map_of_predecessors el) map_of_predecessors successors in (*instead of this just remove from rhs*) - (new_set, removed_terms_set, map_of_children, map_of_predecessors) in - TSet.fold add_to_result set (TSet.empty, TSet.empty, TUF.ValMap.empty, TUF.ValMap.empty) + (new_set, removed_terms_set, map_of_children) in + TSet.fold add_to_result set (TSet.empty, TSet.empty, TUF.ValMap.empty) let show_map_of_children map_of_children = List.fold_left @@ -363,10 +376,9 @@ module CongruenceClosure (Var : Val) = struct let remove_term t (part, new_parents_map, map_of_children) = match LMap.find_opt t map_of_children with | None -> - (* t has no childrem, so we can safely delete the element from the data structure *) + (* t has no children, so we can safely delete the element from the data structure *) (* we just need to update the size on the whole path from here to the root *) - (* we know that after a find operation the parent of t is a root, because of path compression. *) - let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (fst(TUF.parent part t)) new_parents_map in + let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (TUF.parent part t) new_parents_map in (TUF.ValMap.remove t (TUF.change_size t part ((-) 1)), new_parents_map, map_of_children) | Some children -> let map_of_children = LMap.remove t map_of_children in @@ -389,7 +401,7 @@ module CongruenceClosure (Var : Val) = struct let _ = TUF.modify_parent part new_root (new_root, Z.zero) in (* update size of equivalence class *) let part = TUF.change_size new_root part ((+) new_size) in - (TUF.ValMap.remove t part, LMap.add t new_root new_parents_map, map_of_children) + (TUF.ValMap.remove t part, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) else (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) let (new_root, new_offset) = TUF.parent part t in @@ -403,16 +415,39 @@ module CongruenceClosure (Var : Val) = struct ) map_of_children remaining_children in (* update size of equivalence class *) let part = TUF.change_size new_root part ((-) 1) in - (TUF.ValMap.remove t part, LMap.add t new_root new_parents_map, map_of_children) + (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) in TSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) let show_new_parents_map new_parents_map = List.fold_left - (fun s (v1, v2) -> - s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ "\n") + (fun s (v1, (v2, o2)) -> + s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") "" (LMap.bindings new_parents_map) + let rec find_new_root new_parents_map part v = + match LMap.find_opt v new_parents_map with + | None -> TUF.find_opt part v + | Some (new_parent, new_offset) -> + match find_new_root new_parents_map part new_parent with + | None -> None + | Some (r,o) -> Some (r, Z.(o + new_offset)) + + (** Removes all terms from the mapped values of this map, + if they contain `var` as a subterm. *) + let remove_subterms_from_mapped_values map var = + LMap.filter_if map (not % is_subterm var) + + (** For all the elements in the removed terms set, it moves the mapped value to the new root. *) + let remove_terms_containing_variable_from_map (part, map) removed_terms_set new_parents_map = + let remove_from_map map term = match LMap.find_opt term map with + | None -> map + | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) + match find_new_root new_parents_map part term with + | None -> LMap.remove term map + | Some (new_root, new_offset) -> LMap.shift new_root new_offset term map + in List.fold_left remove_from_map map (elements removed_terms_set) end + (** TODO add comment. Minimal representatives map. *) module MRMap = struct @@ -439,14 +474,12 @@ module CongruenceClosure (Var : Val) = struct let rec update_min_repr (part, map) min_representatives = function | [] -> min_representatives | state::queue -> (* process all outgoing edges in order of ascending edge labels *) - match LMap.zmap_bindings (find state map) with - | exception Not_found -> (* no outgoing edges *) - update_min_repr (part, map) min_representatives queue + match LMap.outgoing_transitions state map with | edges -> let process_edge (min_representatives, queue) (edge_z, next_term) = let (next_state, next_z) = TUF.find part next_term in let (min_term, min_z) = find state min_representatives in - let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in (**TODO Why next_z. Is next term really exactly equl to nextx min? Probably?*) + let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in (**TODO WTF next_z. Is next term really exactly equl to nextx min? Probably?*) match TMap.find_opt next_state min_representatives with | None -> @@ -476,6 +509,7 @@ module CongruenceClosure (Var : Val) = struct Therefore the queue is a list of representative terms. *) let update_min_repr (part, map) min_representatives queue = (* order queue by size of the current min representative *) + (* print_string @@ List.fold_left (fun s term -> s ^ T.show term ^ "\n") "" queue ; *) let queue = List.sort_unique (fun el1 el2 -> print_string (T.show el2); print_string (T.show (fst (find el2 min_representatives))); TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root part) queue) in update_min_repr (part, map) min_representatives queue @@ -512,7 +546,8 @@ module CongruenceClosure (Var : Val) = struct set: SSet.t; map: LMap.t; min_repr: MRMap.t} - [@@deriving eq, ord, hash] + [@@deriving eq, ord] + let string_of_prop = function | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 @@ -526,7 +561,13 @@ module CongruenceClosure (Var : Val) = struct let print_conj = print_string % show_conj let get_transitions (part, map) = - List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> (edge_z, t, TUF.find part res_t)) @@ LMap.zmap_bindings imap) else None) (LMap.bindings map) + List.flatten @@ List.filter_map + (fun (t, imap) -> if TUF.is_root part t then Some + (List.map + (fun (edge_z, res_t) -> + (edge_z, t, TUF.find part (LMap.set_any res_t))) @@ + (LMap.zmap_bindings imap)) else None) + (LMap.bindings map) (* Runtime = O(nrr. of atoms) + O(nr. transitions in the automata) *) let get_normal_form cc = @@ -584,7 +625,7 @@ module CongruenceClosure (Var : Val) = struct *) let rec closure (part, map, min_repr) queue = function | [] -> (part, map, queue, min_repr) - | (t1, t2, r)::rest -> + | (t1, t2, r)::rest -> (*print_string "\nt1: "; print_string (T.show t1); print_string "\nt2: "; print_string (T.show t2);print_string "\n"; *) (match TUF.find part t1, TUF.find part t2 with | (v1,r1), (v2,r2) -> if T.compare v1 v2 = 0 then @@ -601,19 +642,23 @@ module CongruenceClosure (Var : Val) = struct | Some imap1, Some imap2, true -> (* v1 is new root *) (* zmap describes args of Deref *) let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap2) in + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match LMap.zmap_find_opt r' zmap with - | None -> (LMap.zmap_add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap1,rest) infl2 in + let rest = match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (LMap.set_any v', LMap.set_any v'',Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) + (imap1,rest) infl2 in LMap.remove v2 (LMap.add v zmap map), rest | Some imap1, Some imap2, false -> (* v2 is new root *) let r0 = Z.(r1-r2-r) in let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - match LMap.zmap_find_opt r' zmap with - | None -> (LMap.zmap_add r' v' zmap, rest) - | Some v'' -> (zmap, (v',v'',Z.zero)::rest)) (imap2, rest) infl1 in + let rest = + match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (LMap.set_any v',LMap.set_any v'',Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in LMap.remove v1 (LMap.add v zmap map), rest in (* update min_repr *) @@ -760,12 +805,17 @@ module CongruenceClosure (Var : Val) = struct (** Remove terms from the data structure. It removes all terms for which "var" is a subterm from the data structure, - while maintaining all equalities about variables that are not being removed. - let remove_terms_containing_variable cc var = - (* first find all terms that need to be removed *) - let new_set, removed_terms_set, map_of_children, map_of_predecessors = - SSet.remove_terms_containing_variable (cc.part, cc.set, cc.map) var - in let part, new_parents_map, map_of_children = TUF.remove_terms_containing_variable cc.part removed_terms_set map_of_children var - in () - *) + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variable cc var = + (* first find all terms that need to be removed *) + let new_set, removed_terms_set, map_of_children = + SSet.remove_terms_containing_variable (cc.part, cc.set) var + in let part, new_parents_map, _ = + SSet.remove_terms_containing_variable_from_uf cc.part removed_terms_set map_of_children + in let new_map = + SSet.remove_subterms_from_mapped_values cc.map var + in let new_map = + SSet.remove_terms_containing_variable_from_map (part, new_map) removed_terms_set new_parents_map + in {part = part; set = new_set; map = new_map; min_repr = cc.min_repr (* TODO *)} + end From 918aa28470352dbed74c558b896d08b78dfb7ae4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 3 Apr 2024 13:55:23 +0200 Subject: [PATCH 023/323] moved some functions to anotjer module --- src/cdomains/congruenceClosure.ml | 169 +++++++++++++++--------------- 1 file changed, 84 insertions(+), 85 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7acf9cbce1..e8859a7f9e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -363,88 +363,6 @@ module CongruenceClosure (Var : Val) = struct s ^ Z.to_string r ^ " " ^T.show v ^ "; ") "\t" list ^ "\n") "" (TUF.ValMap.bindings map_of_predecessors) - - - - (* remove variables from union find *) - (** Returns part, new_parents_map, new_map_of_children *) - let remove_terms_containing_variable_from_uf part removed_terms_set map_of_children = - let find_not_removed_element set = match List.find (fun el -> not (TSet.mem el removed_terms_set)) set with - | exception Not_found -> List.first set - | t -> t - in - let remove_term t (part, new_parents_map, map_of_children) = - match LMap.find_opt t map_of_children with - | None -> - (* t has no children, so we can safely delete the element from the data structure *) - (* we just need to update the size on the whole path from here to the root *) - let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (TUF.parent part t) new_parents_map in - (TUF.ValMap.remove t (TUF.change_size t part ((-) 1)), new_parents_map, map_of_children) - | Some children -> - let map_of_children = LMap.remove t map_of_children in - if TUF.is_root part t then - (* t is a root and it has some children: - 1. choose new root. - The new_root is in any case one of the children of the old root. - If possible, we choose one of the children that is not going to be deleted. *) - let new_root = find_not_removed_element children in - let remaining_children = List.remove children new_root in - let offset_new_root = TUF.parent_offset part new_root in - (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) - let new_size, map_of_children = List.fold - (fun (total_size, map_of_children) child -> - (* update parent and offset *) - let _ = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in - total_size + TUF.subtree_size part child, add_to_map_of_children child map_of_children new_root - ) (0, map_of_children) remaining_children in - (* Update new root -> set itself as new parent. *) - let _ = TUF.modify_parent part new_root (new_root, Z.zero) in - (* update size of equivalence class *) - let part = TUF.change_size new_root part ((+) new_size) in - (TUF.ValMap.remove t part, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) - else - (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) - let (new_root, new_offset) = TUF.parent part t in - let remaining_children = List.remove children new_root in - (* update all parents of the children of t *) - let map_of_children = List.fold - (fun map_of_children child -> - (* update parent and offset *) - TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t + new_offset)); - add_to_map_of_children child map_of_children new_root - ) map_of_children remaining_children in - (* update size of equivalence class *) - let part = TUF.change_size new_root part ((-) 1) in - (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) - in TSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) - - let show_new_parents_map new_parents_map = List.fold_left - (fun s (v1, (v2, o2)) -> - s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") - "" (LMap.bindings new_parents_map) - - let rec find_new_root new_parents_map part v = - match LMap.find_opt v new_parents_map with - | None -> TUF.find_opt part v - | Some (new_parent, new_offset) -> - match find_new_root new_parents_map part new_parent with - | None -> None - | Some (r,o) -> Some (r, Z.(o + new_offset)) - - (** Removes all terms from the mapped values of this map, - if they contain `var` as a subterm. *) - let remove_subterms_from_mapped_values map var = - LMap.filter_if map (not % is_subterm var) - - (** For all the elements in the removed terms set, it moves the mapped value to the new root. *) - let remove_terms_containing_variable_from_map (part, map) removed_terms_set new_parents_map = - let remove_from_map map term = match LMap.find_opt term map with - | None -> map - | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) - match find_new_root new_parents_map part term with - | None -> LMap.remove term map - | Some (new_root, new_offset) -> LMap.shift new_root new_offset term map - in List.fold_left remove_from_map map (elements removed_terms_set) end @@ -802,6 +720,87 @@ module CongruenceClosure (Var : Val) = struct let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in cc + (*remove variables*) + + (* remove variables from union find *) + (** Returns part, new_parents_map, new_map_of_children *) + let remove_terms_containing_variable_from_uf part removed_terms_set map_of_children = + let find_not_removed_element set = match List.find (fun el -> not (SSet.mem el removed_terms_set)) set with + | exception Not_found -> List.first set + | t -> t + in + let remove_term t (part, new_parents_map, map_of_children) = + match LMap.find_opt t map_of_children with + | None -> + (* t has no children, so we can safely delete the element from the data structure *) + (* we just need to update the size on the whole path from here to the root *) + let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (TUF.parent part t) new_parents_map in + (TUF.ValMap.remove t (TUF.change_size t part ((-) 1)), new_parents_map, map_of_children) + | Some children -> + let map_of_children = LMap.remove t map_of_children in + if TUF.is_root part t then + (* t is a root and it has some children: + 1. choose new root. + The new_root is in any case one of the children of the old root. + If possible, we choose one of the children that is not going to be deleted. *) + let new_root = find_not_removed_element children in + let remaining_children = List.remove children new_root in + let offset_new_root = TUF.parent_offset part new_root in + (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) + let new_size, map_of_children = List.fold + (fun (total_size, map_of_children) child -> + (* update parent and offset *) + let _ = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in + total_size + TUF.subtree_size part child, SSet.add_to_map_of_children child map_of_children new_root + ) (0, map_of_children) remaining_children in + (* Update new root -> set itself as new parent. *) + let _ = TUF.modify_parent part new_root (new_root, Z.zero) in + (* update size of equivalence class *) + let part = TUF.change_size new_root part ((+) new_size) in + (TUF.ValMap.remove t part, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) + else + (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) + let (new_root, new_offset) = TUF.parent part t in + let remaining_children = List.remove children new_root in + (* update all parents of the children of t *) + let map_of_children = List.fold + (fun map_of_children child -> + (* update parent and offset *) + TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t + new_offset)); + SSet.add_to_map_of_children child map_of_children new_root + ) map_of_children remaining_children in + (* update size of equivalence class *) + let part = TUF.change_size new_root part ((-) 1) in + (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) + in SSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) + + let show_new_parents_map new_parents_map = List.fold_left + (fun s (v1, (v2, o2)) -> + s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") + "" (LMap.bindings new_parents_map) + + let rec find_new_root new_parents_map part v = + match LMap.find_opt v new_parents_map with + | None -> TUF.find_opt part v + | Some (new_parent, new_offset) -> + match find_new_root new_parents_map part new_parent with + | None -> None + | Some (r,o) -> Some (r, Z.(o + new_offset)) + + (** Removes all terms from the mapped values of this map, + if they contain `var` as a subterm. *) + let remove_subterms_from_mapped_values map var = + LMap.filter_if map (not % SSet.is_subterm var) + + (** For all the elements in the removed terms set, it moves the mapped value to the new root. *) + let remove_terms_containing_variable_from_map (part, map) removed_terms_set new_parents_map = + let remove_from_map map term = match LMap.find_opt term map with + | None -> map + | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) + match find_new_root new_parents_map part term with + | None -> LMap.remove term map + | Some (new_root, new_offset) -> LMap.shift new_root new_offset term map + in List.fold_left remove_from_map map (SSet.elements removed_terms_set) (** Remove terms from the data structure. It removes all terms for which "var" is a subterm from the data structure, @@ -811,11 +810,11 @@ module CongruenceClosure (Var : Val) = struct let new_set, removed_terms_set, map_of_children = SSet.remove_terms_containing_variable (cc.part, cc.set) var in let part, new_parents_map, _ = - SSet.remove_terms_containing_variable_from_uf cc.part removed_terms_set map_of_children + remove_terms_containing_variable_from_uf cc.part removed_terms_set map_of_children in let new_map = - SSet.remove_subterms_from_mapped_values cc.map var + remove_subterms_from_mapped_values cc.map var in let new_map = - SSet.remove_terms_containing_variable_from_map (part, new_map) removed_terms_set new_parents_map + remove_terms_containing_variable_from_map (part, new_map) removed_terms_set new_parents_map in {part = part; set = new_set; map = new_map; min_repr = cc.min_repr (* TODO *)} end From e09519c2c206939e645e77e95e4b1794738298d5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Apr 2024 10:47:28 +0200 Subject: [PATCH 024/323] fixed bug with size of equivalence classes when removing elements --- src/cdomains/congruenceClosure.ml | 4 ++-- src/cdomains/weaklyRelationalPointerDomain.ml | 2 -- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index e8859a7f9e..b938be0fba 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -735,7 +735,7 @@ module CongruenceClosure (Var : Val) = struct (* t has no children, so we can safely delete the element from the data structure *) (* we just need to update the size on the whole path from here to the root *) let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (TUF.parent part t) new_parents_map in - (TUF.ValMap.remove t (TUF.change_size t part ((-) 1)), new_parents_map, map_of_children) + (TUF.ValMap.remove t (TUF.change_size t part pred), new_parents_map, map_of_children) | Some children -> let map_of_children = LMap.remove t map_of_children in if TUF.is_root part t then @@ -770,7 +770,7 @@ module CongruenceClosure (Var : Val) = struct SSet.add_to_map_of_children child map_of_children new_root ) map_of_children remaining_children in (* update size of equivalence class *) - let part = TUF.change_size new_root part ((-) 1) in + let part = TUF.change_size new_root part pred in (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) in SSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 237b05de4e..c2024eafa0 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -25,8 +25,6 @@ module D : Lattice.S = struct | None -> "⊥" | Some x -> show_conj (get_normal_form x) - - let show_all = function | None -> "⊥\n" | Some x -> "Union Find partition:\n" ^ From ca60f8e82971245f4dda8fc91a18e60da9c1da94 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Apr 2024 13:33:01 +0200 Subject: [PATCH 025/323] update comments --- src/cdomains/congruenceClosure.ml | 238 ++++++++++++++++-------------- 1 file changed, 124 insertions(+), 114 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b938be0fba..6f0270ff1b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -42,17 +42,20 @@ module UnionFind (Val: Val) = struct let init : Val.t list -> t = List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) - (** Returns true if v is the representative value of its equivalence class - - Throws "Unknown value" if v is not present in the data structure. *) - let is_root uf v = match ValMap.find_opt v uf with - | None -> raise (UnknownValue v) - | Some (refv, _) -> Val.compare v (fst !refv) = 0 - + (** `parent uf v` returns (p, z) where p is the parent element of + v in the union find tree and z is the offset. *) let parent uf v = let (refv, _) = ValMap.find v uf in !refv + (** `parent_opt uf v` returns Some (p, z) where p is the parent element of + v in the union find tree and z is the offset. + It returns None if v is not present in the data structure. *) + let parent_opt uf v = + match ValMap.find_opt v uf with + | None -> None + | Some _ -> Some (parent uf v) + let parent_offset uf v = snd (parent uf v) @@ -66,7 +69,17 @@ module UnionFind (Val: Val) = struct i.e. every node is a root. *) let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst !refv) = 0) (ValMap.bindings uf) - (** Throws "Unknown value" if v is not present in the data structure. *) + (** Returns true if v is the representative value of its equivalence class + + Throws "Unknown value" if v is not present in the data structure. *) + let is_root uf v = match parent_opt uf v with + | None -> raise (UnknownValue v) + | Some (parent_t, _) -> Val.compare v parent_t = 0 + + (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements + grouped by equivalence classes, while this function just prints them in any order. + + Throws "Unknown value" if v is not present in the data structure. *) let show_uf_ugly uf = List.fold_left (fun s (v, (refv, size)) -> s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ @@ -78,6 +91,7 @@ module UnionFind (Val: Val) = struct This find performs path compression. Throws "Unknown value" if t is not present in the data structure. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. *) let find uf v = match ValMap.find_opt v uf with @@ -93,14 +107,15 @@ module UnionFind (Val: Val) = struct | None -> raise (UnknownValue v) | Some (refv,_) -> let (v',r') = !refv in if is_root uf v' then - let _ = List.fold_left (fun r0 refv -> - let (_,r'') = !refv in - let _ = refv := (v',Z.(r0+r'')) - in Z.(r0+r'')) Z.zero (refv::list) + let _ = List.fold_left (fun r0 v -> + let r'' = parent_offset uf v in + let _ = modify_parent uf v (v',Z.(r0+r'')) + in Z.(r0+r'')) Z.zero (v::list) in (v',r') - else search v' (refv :: list) - in search v' [refv] + else search v' (v :: list) + in search v' [v] + (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) let find_opt uf v = match find uf v with | exception (UnknownValue _) | exception (InvalidUnionFind _) -> None @@ -112,6 +127,7 @@ module UnionFind (Val: Val) = struct This find DOES NOT perform path compression. Throws "Unknown value" if t is not present in the data structure. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. *) let rec find_no_pc uf v = match ValMap.find_opt v uf with @@ -124,6 +140,8 @@ module UnionFind (Val: Val) = struct let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare + (** Compare only first element of the tuples (= the parent term). + It ignores the offset. *) let compare_repr_v (v1, _) (v2, _) = Val.compare v1 v2 (** @@ -149,15 +167,16 @@ module UnionFind (Val: Val) = struct | Some (refv1,s1), Some (refv2,s2) -> if s1 <= s2 then ( - refv1 := (v2, Z.(r2 - r1 + r)); - v2, ValMap.add v2 (refv2,s1+s2) uf, false + modify_parent uf v1 (v2, Z.(r2 - r1 + r)); + v2, ValMap.add v2 (refv2, s1+s2) uf, false ) else ( - refv2 := (v1, Z.(r1 - r2 - r)); - v1, ValMap.add v1 (refv1,s1+s2) uf, true + modify_parent uf v2 (v1, Z.(r1 - r2 - r)); + v1, ValMap.add v1 (refv1, s1+s2) uf, true ) | None, _ -> raise (UnknownValue v1) | _, _ -> raise (UnknownValue v2) + (** Returns a list of equivalence classes. *) let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find uf el1) (find uf el2)) (ValMap.bindings uf) (** Throws "Unknown value" if v is not present in the data structure. *) @@ -167,9 +186,9 @@ module UnionFind (Val: Val) = struct ^ "\n") "" (get_eq_classes uf) ^ "\n" (** Modifies the size of the equivalence class for the current element and - for the while path to the root of this element. + for the whole path to the root of this element. - `modification` is the function to apply to the sizes. *) + The third parameter `modification` is the function to apply to the sizes. *) let rec change_size t part modification = let (ref_r, old_size) = ValMap.find t part in let part = ValMap.add t (ref_r, modification old_size) part in @@ -197,6 +216,7 @@ module LookupMap (T: Val) = struct let find = TMap.find let zmap_bindings = ZMap.bindings + (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). *) let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) let zmap_find_opt = ZMap.find_opt @@ -247,16 +267,13 @@ module LookupMap (T: Val) = struct zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in remove v' (add v zmap map) + (** Find all outgoing edges of v.*) let successors v map = match find_opt v map with | None -> [] | Some zmap -> zmap_bindings_one_successor zmap - let outgoing_transitions state map = - match find_opt state map with - | None -> [] - | Some zmap -> zmap_bindings_one_successor zmap - + (** Filters elements from the mapped values which fulfil the predicate p. *) let filter_if map p = TMap.filter_map (fun _ zmap -> let zmap = ZMap.filter_map @@ -293,6 +310,7 @@ module CongruenceClosure (Var : Val) = struct (** Set of subterms which are present in the current data structure *) module SSet = struct module TSet = ValSet(T) + module TMap = ValMap(T) type t = TSet.t [@@deriving eq, ord, hash] let elements = TSet.elements @@ -323,27 +341,35 @@ module CongruenceClosure (Var : Val) = struct let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list let get_atoms set = - (* elements set returns a sorted list of the elements. The atoms are always smaller that pther terms, - according to our comparison function. Therefore take_while is enough.*) + (* `elements set` returns a sorted list of the elements. The atoms are always smaller that other terms, + according to our comparison function. Therefore take_while is enough. *) BatList.take_while (function Addr _ -> true | _ -> false) (elements set) - let add_to_map_of_children value map term = if T.equal term value then map else - match TUF.ValMap.find_opt term map with - | None -> TUF.ValMap.add term [value] map - | Some list -> TUF.ValMap.add term (value::list) map + match TMap.find_opt term map with + | None -> TMap.add term [value] map + | Some list -> TMap.add term (value::list) map - (* remove varibales *) - (** Returns new_set, removed_terms_set, map_of_children *) + (* remove variables *) + + (** Parameters: + - `(part, set)`: union find tree and set of subterms that are present in the union find data structure. + - `var`: variable that needs to be removed from the data structure. + + Returns: + - `new_set`: subset of `set` which contains the terms that do not have var as a subterm. + - `removed_terms_set`: subset of `set` which contains the terms that have var as a subterm. + - `map_of_children`: maps each element of union find to its children in the union find tree. It is used in order to later remove these elements from the union find data structure. + *) let remove_terms_containing_variable (part, set) var = - (** Adds `value` to the set that is in the `map` with key `term` *) + (* Adds `value` to the set that is in the `map` with key `term` *) let add_to_result el (new_set, removed_terms_set, map_of_children) = let new_set, removed_terms_set = if is_subterm var el then new_set, add el removed_terms_set else add el new_set, removed_terms_set in - let (uf_parent_ref, _) = TUF.ValMap.find el part in + let (uf_parent_ref, _) = TMap.find el part in let map_of_children = add_to_map_of_children el map_of_children (fst !uf_parent_ref) in (new_set, removed_terms_set, map_of_children) in - TSet.fold add_to_result set (TSet.empty, TSet.empty, TUF.ValMap.empty) + TSet.fold add_to_result set (TSet.empty, TSet.empty, TMap.empty) let show_map_of_children map_of_children = List.fold_left @@ -353,25 +379,15 @@ module CongruenceClosure (Var : Val) = struct (fun s v -> s ^ T.show v ^ "; ") "\t" list ^ "\n") - "" (TUF.ValMap.bindings map_of_children) - - let show_map_of_predecessors map_of_predecessors = List.fold_left - (fun s (v, list) -> - s ^ T.show v ^ "\t:\n" ^ - List.fold_left - (fun s (r, v) -> - s ^ Z.to_string r ^ " " ^T.show v ^ "; ") - "\t" list ^ "\n") - "" (TUF.ValMap.bindings map_of_predecessors) + "" (TMap.bindings map_of_children) end - - (** TODO add comment. - Minimal representatives map. *) + (** Minimal representatives map. + It maps each representative term of an equivalence class to the minimal term of this representative class. *) module MRMap = struct - module TMap = ValMap(T) + module TMap = Map.Make(T) - type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] + type t = (T.t * Z.t) TMap.t [@@deriving eq, ord] let bindings = TMap.bindings let find = TMap.find @@ -392,12 +408,12 @@ module CongruenceClosure (Var : Val) = struct let rec update_min_repr (part, map) min_representatives = function | [] -> min_representatives | state::queue -> (* process all outgoing edges in order of ascending edge labels *) - match LMap.outgoing_transitions state map with + match LMap.successors state map with | edges -> let process_edge (min_representatives, queue) (edge_z, next_term) = let (next_state, next_z) = TUF.find part next_term in let (min_term, min_z) = find state min_representatives in - let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in (**TODO WTF next_z. Is next term really exactly equl to nextx min? Probably?*) + let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in match TMap.find_opt next_state min_representatives with | None -> @@ -410,32 +426,30 @@ module CongruenceClosure (Var : Val) = struct in update_min_repr (part, map) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of - all edges in the queue and if necessary also updates the minimal representatives of - the successor nodes of the automata. - The states in the queu must already have an updated min_repr. + the successor nodes of all edges in the queue + and if necessary it recursively updates the minimal representatives of the successor nodes. + The states in the queue must already have an updated min_repr. This function visits only the successor nodes of the nodes in queue, not the nodes themselves. - Before visiting the nodes, it sorts the queue by the size of the current min representative. + Before visiting the nodes, it sorts the queue by the size of the current mininmal representative. parameters: - `(part, map)` represent the union find data tructure and the corresponding lookup map + - `(part, map)` represent the union find data structure and the corresponding lookup map. - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class + - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. - `queue` contains the states that need to be processed. + - `queue` contains the states that need to be processed. The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. Therefore the queue is a list of representative terms. *) let update_min_repr (part, map) min_representatives queue = (* order queue by size of the current min representative *) - (* print_string @@ List.fold_left (fun s term -> s ^ T.show term ^ "\n") "" queue ; *) let queue = - List.sort_unique (fun el1 el2 -> print_string (T.show el2); print_string (T.show (fst (find el2 min_representatives))); TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root part) queue) + List.sort_unique (fun el1 el2 -> TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root part) queue) in update_min_repr (part, map) min_representatives queue - (** Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. - I think it's not used for now, because we compute the minimal representatives incrementally. + It's used for now when removing elements, then the min_repr map gets recomputed. *) let compute_minimal_representatives (part, set, map) = let atoms = SSet.get_atoms set in @@ -452,12 +466,10 @@ module CongruenceClosure (Var : Val) = struct (* compute the minimal representative of all remaining edges *) in update_min_repr (part, map) min_representatives queue - (** - Computes the initial map of minimal representatives. + (** Computes the initial map of minimal representatives. It maps each element `e` in the set to `(e, 0)`. *) let initial_minimal_representatives set = List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) - end type t = {part: TUF.t; @@ -466,7 +478,6 @@ module CongruenceClosure (Var : Val) = struct min_repr: MRMap.t} [@@deriving eq, ord] - let string_of_prop = function | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 | Eq (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 @@ -478,6 +489,7 @@ module CongruenceClosure (Var : Val) = struct let print_conj = print_string % show_conj + (** Returns a list of all the transition that are present in the automata. *) let get_transitions (part, map) = List.flatten @@ List.filter_map (fun (t, imap) -> if TUF.is_root part t then Some @@ -487,7 +499,8 @@ module CongruenceClosure (Var : Val) = struct (LMap.zmap_bindings imap)) else None) (LMap.bindings map) - (* Runtime = O(nrr. of atoms) + O(nr. transitions in the automata) *) + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) *) + (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = let normalize_equality (t1, t2, z) = if t1 = t2 && Z.(compare z zero) = 0 then None else @@ -512,13 +525,13 @@ module CongruenceClosure (Var : Val) = struct (** returns {part, set, map, min_repr}, where: - - `part` = empty union find structure where the elements are all subterms occuring in the conjunction + - `part` = empty union find structure where the elements are all subterms occuring in the conjunction. - - `set` = set of all subterms occuring in the conjunction + - `set` = set of all subterms occuring in the conjunction. - - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t') + - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t'). - - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class + - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. *) let init_cc conj = let (set, map) = SSet.subterms_of_conj conj in @@ -528,22 +541,22 @@ module CongruenceClosure (Var : Val) = struct {part = part; set = set; map = map ; min_repr = min_repr} (** - parameters: (part, map) equalities + parameters: (part, map) equalities. returns updated (part, map, queue), where: - part is the new union find data structure after having added all equalities + `part` is the new union find data structure after having added all equalities. - map maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z) + `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - queue is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. + `queue` is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map. Throws "Unsat" if a contradiction is found. *) let rec closure (part, map, min_repr) queue = function | [] -> (part, map, queue, min_repr) - | (t1, t2, r)::rest -> (*print_string "\nt1: "; print_string (T.show t1); print_string "\nt2: "; print_string (T.show t2);print_string "\n"; *) + | (t1, t2, r)::rest -> (match TUF.find part t1, TUF.find part t2 with | (v1,r1), (v2,r2) -> if T.compare v1 v2 = 0 then @@ -581,7 +594,7 @@ module CongruenceClosure (Var : Val) = struct in (* update min_repr *) let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in - (* 'changed' is true if the new_min is different thatn the old min *) + (* 'changed' is true if the new_min is different than the old min *) let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in let (_, rep_v) = TUF.find part new_min in let removed_v = if b then v2 else v1 in @@ -591,15 +604,15 @@ module CongruenceClosure (Var : Val) = struct ) (** - Parameters: (part, map, min_repr) conjunctions + Parameters: (part, map, min_repr) conjunctions. returns updated (part, map, min_repr), where: - - `part` is the new union find data structure after having added all equalities + - `part` is the new union find data structure after having added all equalities. - - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z) + - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - - `min_repr` maps each equivalence class to its minimal representative + - `min_repr` maps each equivalence class to its minimal representative. *) let closure cc conjs = @@ -607,31 +620,20 @@ module CongruenceClosure (Var : Val) = struct let min_repr = MRMap.update_min_repr (part, map) min_repr queue in {part = part; set = cc.set; map = map; min_repr = min_repr} - let fold_left2 f acc l1 l2 = - List.fold_left ( - fun acc x -> List.fold_left ( - fun acc y -> f acc x y) acc l2) acc l1 - - let map2 f l1 l2 = List.concat ( - List.map (fun x -> - List.map (fun y -> f x y) l2) l1) - (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) let split conj = List.fold_left (fun (pos,neg) -> function | Eq (t1,t2,r) -> ((t1,t2,r)::pos,neg) | Neq(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj - (** - Throws Unsat if the congruence is unsatisfiable.*) + (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = let cc = init_cc conj in let pos, _ = split conj in (* propagating equalities through derefs *) closure cc pos - (** - Returns None if the congruence is unsatisfiable.*) + (** Returns None if the congruence is unsatisfiable.*) let init_congruence_opt conj = let cc = init_cc conj in let pos, _ = split conj in @@ -640,7 +642,7 @@ module CongruenceClosure (Var : Val) = struct | exception Unsat -> None | x -> Some x - (** Add a term to the data structure + (** Add a term to the data structure. Returns (reference variable, offset), updated (part, set, map, min_repr), and queue, that needs to be passed as a parameter to `update_min_repr`. @@ -658,14 +660,14 @@ module CongruenceClosure (Var : Val) = struct | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in match LMap.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> TUF.find cc.part v', cc, queue + | Some v' -> TUF.find cc.part v', cc, queue (*TODO do we need thi find? I think this is the reason that the dpth is always 1?*) (* TODO don't we need a union here? *) | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let part = LMap.add t (ref (t, Z.zero),1) cc.part in let min_repr = LMap.add t (t, Z.zero) cc.min_repr in (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, queue - (** Add a term to the data structure + (** Add a term to the data structure. Returns (reference variable, offset), updated (part, set, map, min_repr) *) let insert cc t = @@ -674,9 +676,9 @@ module CongruenceClosure (Var : Val) = struct let min_repr = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} - (** Add all terms in a specific set to the data structure + (** Add all terms in a specific set to the data structure. - Returns updated (part, set, map, min_repr) *) + Returns updated (part, set, map, min_repr). *) let insert_set cc t_set = (* SAFE VERSION but less efficient: SSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) @@ -692,7 +694,7 @@ module CongruenceClosure (Var : Val) = struct closure cc (fst (split conjs)) (** - Returns true if t1 and t2 are equivalent + Returns true if t1 and t2 are equivalent. *) let eq_query cc (t1,t2,r) = let (v1,r1),cc = insert cc t1 in @@ -700,7 +702,7 @@ module CongruenceClosure (Var : Val) = struct (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), cc) (** - Returns true if t1 and t2 are not equivalent + Returns true if t1 and t2 are not equivalent. *) let neq_query cc _ (t1,t2,_) = let (v1,r1),cc = insert cc t1 in @@ -711,7 +713,7 @@ module CongruenceClosure (Var : Val) = struct else false (* TODO disequalities *) (** - Add proposition t1 = t2 + r to the data structure + Add proposition t1 = t2 + r to the data structure. *) let add_eq cc (t1, t2, r) = (* should use ineq. for refuting equality *) @@ -720,10 +722,13 @@ module CongruenceClosure (Var : Val) = struct let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in cc - (*remove variables*) + (* remove variables *) - (* remove variables from union find *) - (** Returns part, new_parents_map, new_map_of_children *) + (** Removes all terms containing a variable from the union find data structure. + + Returns: + - `part`: the updated union find tree + - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. *) let remove_terms_containing_variable_from_uf part removed_terms_set map_of_children = let find_not_removed_element set = match List.find (fun el -> not (SSet.mem el removed_terms_set)) set with | exception Not_found -> List.first set @@ -772,13 +777,16 @@ module CongruenceClosure (Var : Val) = struct (* update size of equivalence class *) let part = TUF.change_size new_root part pred in (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) - in SSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) + in + Tuple3.get12 @@ SSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) let show_new_parents_map new_parents_map = List.fold_left (fun s (v1, (v2, o2)) -> s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") "" (LMap.bindings new_parents_map) + (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. + Returns None if there are no elements in the same equivalence class as t before it was deleted.*) let rec find_new_root new_parents_map part v = match LMap.find_opt v new_parents_map with | None -> TUF.find_opt part v @@ -794,27 +802,29 @@ module CongruenceClosure (Var : Val) = struct (** For all the elements in the removed terms set, it moves the mapped value to the new root. *) let remove_terms_containing_variable_from_map (part, map) removed_terms_set new_parents_map = - let remove_from_map map term = match LMap.find_opt term map with + let remove_from_map term map = + match LMap.find_opt term map with | None -> map | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) match find_new_root new_parents_map part term with | None -> LMap.remove term map | Some (new_root, new_offset) -> LMap.shift new_root new_offset term map - in List.fold_left remove_from_map map (SSet.elements removed_terms_set) + in SSet.fold remove_from_map removed_terms_set map (** Remove terms from the data structure. - It removes all terms for which "var" is a subterm from the data structure, + It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable cc var = (* first find all terms that need to be removed *) let new_set, removed_terms_set, map_of_children = SSet.remove_terms_containing_variable (cc.part, cc.set) var - in let part, new_parents_map, _ = + in let new_part, new_parents_map = remove_terms_containing_variable_from_uf cc.part removed_terms_set map_of_children in let new_map = remove_subterms_from_mapped_values cc.map var in let new_map = - remove_terms_containing_variable_from_map (part, new_map) removed_terms_set new_parents_map - in {part = part; set = new_set; map = new_map; min_repr = cc.min_repr (* TODO *)} + remove_terms_containing_variable_from_map (new_part, new_map) removed_terms_set new_parents_map + in let min_repr = MRMap.compute_minimal_representatives (new_part, new_set, new_map) + in {part = new_part; set = new_set; map = new_map; min_repr = min_repr} end From 2ee5239fbe187d9a14c0363c7ca7e346d8d9efd8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Apr 2024 15:27:15 +0200 Subject: [PATCH 026/323] removed the ref in the union find and made size equal to the size of the subtree for all elements in the union find --- src/cdomains/congruenceClosure.ml | 264 ++++++++++++++++-------------- 1 file changed, 139 insertions(+), 125 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6f0270ff1b..6ec90d8115 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -27,7 +27,7 @@ module UnionFind (Val: Val) = struct let hash_ref x y = 3 (** (value * offset) ref * size of equivalence class *) - type 'v node = ('v * Z.t) ref * int [@@deriving eq, ord, hash] + type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] (** Maps each value to its children in the union find data structure. Necessary in order to be able to delete values. *) @@ -40,13 +40,13 @@ module UnionFind (Val: Val) = struct (** create empty union find map *) let init : Val.t list -> t = - List.fold_left (fun map v -> ValMap.add v (ref (v, Z.zero), 1) map) (ValMap.empty) + List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) (** `parent uf v` returns (p, z) where p is the parent element of v in the union find tree and z is the offset. *) let parent uf v = let (refv, _) = ValMap.find v uf in - !refv + refv (** `parent_opt uf v` returns Some (p, z) where p is the parent element of v in the union find tree and z is the offset. @@ -61,13 +61,23 @@ module UnionFind (Val: Val) = struct let subtree_size uf v = snd (ValMap.find v uf) + (** Modifies the size of the equivalence class for the current element and + for the whole path to the root of this element. + + The third parameter `modification` is the function to apply to the sizes. *) + let rec change_size t part modification = + let (ref_r, old_size) = ValMap.find t part in + let part = ValMap.add t (ref_r, modification old_size) part in + let parent = fst(ref_r) in + if parent = t then part else change_size parent part modification + let modify_parent uf v (t, offset) = - let (refv, _) = ValMap.find v uf in - refv := (t, offset) + let (_, size) = ValMap.find v uf in + ValMap.add v ((t, offset), size) uf (** Returns true if each equivalence class in the data structure contains only one element, i.e. every node is a root. *) - let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst !refv) = 0) (ValMap.bindings uf) + let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst refv) = 0) (ValMap.bindings uf) (** Returns true if v is the representative value of its equivalence class @@ -83,12 +93,13 @@ module UnionFind (Val: Val) = struct let show_uf_ugly uf = List.fold_left (fun s (v, (refv, size)) -> s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ - "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^ "\n") + "; Parent: " ^ Val.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") "" (ValMap.bindings uf) ^ "\n" (** For a variable t it returns the reference variable v and the offset r. This find performs path compression. + It returns als the updated union-find tree after the path compression. Throws "Unknown value" if t is not present in the data structure. Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. @@ -96,22 +107,25 @@ module UnionFind (Val: Val) = struct let find uf v = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) - | Some (refv,_) -> let (v',r') = !refv in + | Some (refv,_) -> let (v',r') = refv in if Val.compare v' v = 0 then - if Z.equal r' Z.zero then (v',r') + if Z.equal r' Z.zero then v',r', uf else raise (InvalidUnionFind "non-zero self-distance!") else if is_root uf v' then - (v',r') + v',r', uf else let rec search v list = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) - | Some (refv,_) -> let (v',r') = !refv in + | Some (refv,_) -> let (v',r') = refv in if is_root uf v' then - let _ = List.fold_left (fun r0 v -> - let r'' = parent_offset uf v in - let _ = modify_parent uf v (v',Z.(r0+r'')) - in Z.(r0+r'')) Z.zero (v::list) - in (v',r') + let (_,uf) = List.fold_left (fun (r0,part) v -> + let (parent_v, r'') = parent part v in + let size_v = subtree_size part v in + let part = modify_parent part v (v',Z.(r0+r'')) in + let part = change_size parent_v part (fun s -> s - size_v) in + let part = change_size v' part ((+) size_v) + in Z.(r0+r''),part) (Z.zero,uf) (v::list) + in v',r',uf else search v' (v :: list) in search v' [v] @@ -132,7 +146,7 @@ module UnionFind (Val: Val) = struct let rec find_no_pc uf v = match ValMap.find_opt v uf with | None -> raise (UnknownValue v) - | Some (refv,_) -> let (v',r') = !refv in + | Some ((v',r'),_) -> if Val.compare v' v = 0 then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") @@ -158,43 +172,31 @@ module UnionFind (Val: Val) = struct - `b` is true iff v = find v1 *) - let union uf v'1 v'2 r = let v1,r1 = find uf v'1 in - let v2,r2 = find uf v'2 in + let union uf v'1 v'2 r = let v1,r1,uf = find uf v'1 in + let v2,r2,uf = find uf v'2 in if Val.compare v1 v2 = 0 then if r1 = Z.(r2 + r) then v1, uf, true else raise (Failure "incomparable union") else match ValMap.find_opt v1 uf, ValMap.find_opt v2 uf with - | Some (refv1,s1), - Some (refv2,s2) -> + | Some (_,s1), + Some (_,s2) -> if s1 <= s2 then ( - modify_parent uf v1 (v2, Z.(r2 - r1 + r)); - v2, ValMap.add v2 (refv2, s1+s2) uf, false + v2, change_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false ) else ( - modify_parent uf v2 (v1, Z.(r1 - r2 - r)); - v1, ValMap.add v1 (refv1, s1+s2) uf, true + v1, change_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true ) | None, _ -> raise (UnknownValue v1) | _, _ -> raise (UnknownValue v2) (** Returns a list of equivalence classes. *) - let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find uf el1) (find uf el2)) (ValMap.bindings uf) + let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> s ^ List.fold_left (fun s (v, (refv, size)) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst !refv) ^ "; offset: " ^ Z.to_string (snd !refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" - (** Modifies the size of the equivalence class for the current element and - for the whole path to the root of this element. - - The third parameter `modification` is the function to apply to the sizes. *) - let rec change_size t part modification = - let (ref_r, old_size) = ValMap.find t part in - let part = ValMap.add t (ref_r, modification old_size) part in - let parent = fst(!ref_r) in - if parent = t then part else change_size parent part modification - end module LookupMap (T: Val) = struct @@ -367,7 +369,7 @@ module CongruenceClosure (Var : Val) = struct let add_to_result el (new_set, removed_terms_set, map_of_children) = let new_set, removed_terms_set = if is_subterm var el then new_set, add el removed_terms_set else add el new_set, removed_terms_set in let (uf_parent_ref, _) = TMap.find el part in - let map_of_children = add_to_map_of_children el map_of_children (fst !uf_parent_ref) in + let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent_ref) in (new_set, removed_terms_set, map_of_children) in TSet.fold add_to_result set (TSet.empty, TSet.empty, TMap.empty) @@ -406,23 +408,23 @@ module CongruenceClosure (Var : Val) = struct let print_min_rep = print_string % show_min_rep let rec update_min_repr (part, map) min_representatives = function - | [] -> min_representatives + | [] -> min_representatives, part | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match LMap.successors state map with | edges -> - let process_edge (min_representatives, queue) (edge_z, next_term) = - let (next_state, next_z) = TUF.find part next_term in + let process_edge (min_representatives, queue, part) (edge_z, next_term) = + let next_state, next_z, part = TUF.find part next_term in let (min_term, min_z) = find state min_representatives in let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in match TMap.find_opt next_state min_representatives with | None -> - (add next_state next_min min_representatives, queue @ [next_state]) + (add next_state next_min min_representatives, queue @ [next_state], part) | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (add next_state next_min min_representatives, queue @ [next_state]) - | _ -> (min_representatives, queue) + (add next_state next_min min_representatives, queue @ [next_state], part) + | _ -> (min_representatives, queue, part) in - let (min_representatives, queue) = List.fold_left process_edge (min_representatives, queue) edges + let (min_representatives, queue, part) = List.fold_left process_edge (min_representatives, queue, part) edges in update_min_repr (part, map) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of @@ -435,12 +437,14 @@ module CongruenceClosure (Var : Val) = struct parameters: - `(part, map)` represent the union find data structure and the corresponding lookup map. - - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. - - `queue` contains the states that need to be processed. The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. - Therefore the queue is a list of representative terms. *) + Therefore the queue is a list of representative terms. + + Returns: + - The map with the minimal representatives + - The union find tree. This might have changed because of path compression. *) let update_min_repr (part, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = @@ -450,19 +454,27 @@ module CongruenceClosure (Var : Val) = struct (** Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. It's used for now when removing elements, then the min_repr map gets recomputed. - *) + Returns: + - The map with the minimal representatives + - The union find tree. This might have changed because of path compression. *) let compute_minimal_representatives (part, set, map) = let atoms = SSet.get_atoms set in (* process all atoms in increasing order *) + let part_ref = ref part in let atoms = - List.sort (fun el1 el2 -> TUF.compare_repr (TUF.find part el1) (TUF.find part el2)) atoms in - let add_atom_to_map (min_representatives, queue) a = - let (rep, offs) = TUF.find part a in + List.sort (fun el1 el2 -> + let v1, z1, new_part = TUF.find !part_ref el1 in + part_ref := new_part; + let v2, z2, new_part = TUF.find !part_ref el2 in + part_ref := new_part; + TUF.compare_repr (v1, z1) (v2, z2)) atoms in + let add_atom_to_map (min_representatives, queue, part) a = + let (rep, offs, part) = TUF.find part a in if not (mem rep min_representatives) then - (add rep (a, offs) min_representatives, queue @ [rep]) - else (min_representatives, queue) + (add rep (a, offs) min_representatives, queue @ [rep], part) + else (min_representatives, queue, part) in - let (min_representatives, queue) = List.fold_left add_atom_to_map (empty, []) atoms + let (min_representatives, queue, part) = List.fold_left add_atom_to_map (empty, [], part) atoms (* compute the minimal representative of all remaining edges *) in update_min_repr (part, map) min_representatives queue @@ -495,7 +507,7 @@ module CongruenceClosure (Var : Val) = struct (fun (t, imap) -> if TUF.is_root part t then Some (List.map (fun (edge_z, res_t) -> - (edge_z, t, TUF.find part (LMap.set_any res_t))) @@ + (edge_z, t, TUF.find_no_pc part (LMap.set_any res_t))) @@ (LMap.zmap_bindings imap)) else None) (LMap.bindings map) @@ -508,7 +520,7 @@ module CongruenceClosure (Var : Val) = struct let conjunctions_of_atoms = let atoms = SSet.get_atoms cc.set in List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find cc.part atom in + let (rep_state, rep_z) = TUF.find_no_pc cc.part atom in let (min_state, min_z) = MRMap.find rep_state cc.min_repr in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms @@ -557,50 +569,50 @@ module CongruenceClosure (Var : Val) = struct let rec closure (part, map, min_repr) queue = function | [] -> (part, map, queue, min_repr) | (t1, t2, r)::rest -> - (match TUF.find part t1, TUF.find part t2 with - | (v1,r1), (v2,r2) -> - if T.compare v1 v2 = 0 then - (* t1 and t2 are in the same equivalence class *) - if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest - else raise Unsat - else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) - (* update map *) - let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with - | None, _, false -> map, rest - | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest - | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest - | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) - | Some imap1, Some imap2, true -> (* v1 is new root *) - (* zmap describes args of Deref *) - let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = match LMap.zmap_find_opt r' zmap with - | None -> rest - | Some v'' -> (LMap.set_any v', LMap.set_any v'',Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) - (imap1,rest) infl2 in - LMap.remove v2 (LMap.add v zmap map), rest - | Some imap1, Some imap2, false -> (* v2 is new root *) - let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = - match LMap.zmap_find_opt r' zmap with - | None -> rest - | Some v'' -> (LMap.set_any v',LMap.set_any v'',Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in - LMap.remove v1 (LMap.add v zmap map), rest - in - (* update min_repr *) - let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in - (* 'changed' is true if the new_min is different than the old min *) - let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in - let (_, rep_v) = TUF.find part new_min in - let removed_v = if b then v2 else v1 in - let min_repr = MRMap.remove removed_v (if changed then MRMap.add v (new_min, rep_v) min_repr else min_repr) in - let queue = if changed then (v :: queue) else queue in - closure (part, map, min_repr) queue rest + (let v1, r1, part = TUF.find part t1 in + let v2, r2, part = TUF.find part t2 in + if T.compare v1 v2 = 0 then + (* t1 and t2 are in the same equivalence class *) + if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest + else raise Unsat + else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) + (* update map *) + let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with + | None, _, false -> map, rest + | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest + | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + let rest = match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (LMap.set_any v', LMap.set_any v'',Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) + (imap1,rest) infl2 in + LMap.remove v2 (LMap.add v zmap map), rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + let rest = + match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (LMap.set_any v',LMap.set_any v'',Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in + LMap.remove v1 (LMap.add v zmap map), rest + in + (* update min_repr *) + let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in + (* 'changed' is true if the new_min is different than the old min *) + let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in + let (_, rep_v, part) = TUF.find part new_min in + let removed_v = if b then v2 else v1 in + let min_repr = MRMap.remove removed_v (if changed then MRMap.add v (new_min, rep_v) min_repr else min_repr) in + let queue = if changed then (v :: queue) else queue in + closure (part, map, min_repr) queue rest ) (** @@ -617,7 +629,7 @@ module CongruenceClosure (Var : Val) = struct *) let closure cc conjs = let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in - let min_repr = MRMap.update_min_repr (part, map) min_repr queue in + let min_repr, part = MRMap.update_min_repr (part, map) min_repr queue in {part = part; set = cc.set; map = map; min_repr = min_repr} (** Splits the conjunction into two groups: the first one contains all equality propositions, @@ -651,19 +663,21 @@ module CongruenceClosure (Var : Val) = struct Therefore it contains either one or zero elements. *) let rec insert_no_min_repr cc t = if SSet.mem t cc.set then - TUF.find cc.part t, cc,[] + let v,z,part = TUF.find cc.part t in + (v,z), {part = part; set = cc.set; map = cc.map; min_repr = cc.min_repr}, [] else let set = SSet.add t cc.set in match t with - | Addr a -> let part = LMap.add t (ref (t, Z.zero),1) cc.part in + | Addr a -> let part = LMap.add t ((t, Z.zero),1) cc.part in let min_repr = LMap.add t (t, Z.zero) cc.min_repr in (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in match LMap.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> TUF.find cc.part v', cc, queue (*TODO do we need thi find? I think this is the reason that the dpth is always 1?*) + | Some v' -> let v,z,part = TUF.find cc.part v' in + (v,z), {part = part; set = cc.set; map = cc.map; min_repr = cc.min_repr}, queue (* TODO don't we need a union here? *) | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in - let part = LMap.add t (ref (t, Z.zero),1) cc.part in + let part = LMap.add t ((t, Z.zero),1) cc.part in let min_repr = LMap.add t (t, Z.zero) cc.min_repr in (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, queue @@ -673,8 +687,8 @@ module CongruenceClosure (Var : Val) = struct let insert cc t = let v, cc, queue = insert_no_min_repr cc t in (* the queue has at most one element, so there is no need to sort it *) - let min_repr = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in - v, {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} + let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in + v, {part = part; set = cc.set; map = cc.map; min_repr = min_repr} (** Add all terms in a specific set to the data structure. @@ -682,9 +696,8 @@ module CongruenceClosure (Var : Val) = struct let insert_set cc t_set = (* SAFE VERSION but less efficient: SSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in - {part = cc.part; set = cc.set; map = cc.map; min_repr = min_repr} - + let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in + {part = part; set = cc.set; map = cc.map; min_repr = min_repr} (** Throws "Unsat" if a contradiction is found. @@ -768,12 +781,12 @@ module CongruenceClosure (Var : Val) = struct let (new_root, new_offset) = TUF.parent part t in let remaining_children = List.remove children new_root in (* update all parents of the children of t *) - let map_of_children = List.fold - (fun map_of_children child -> + let map_of_children, part = List.fold + (fun (map_of_children, part) child -> (* update parent and offset *) - TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t + new_offset)); - SSet.add_to_map_of_children child map_of_children new_root - ) map_of_children remaining_children in + SSet.add_to_map_of_children child map_of_children new_root, + TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t + new_offset)) + ) (map_of_children, part) remaining_children in (* update size of equivalence class *) let part = TUF.change_size new_root part pred in (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) @@ -793,23 +806,24 @@ module CongruenceClosure (Var : Val) = struct | Some (new_parent, new_offset) -> match find_new_root new_parents_map part new_parent with | None -> None - | Some (r,o) -> Some (r, Z.(o + new_offset)) + | Some (r, o, part) -> Some (r, Z.(o + new_offset), part) (** Removes all terms from the mapped values of this map, if they contain `var` as a subterm. *) let remove_subterms_from_mapped_values map var = LMap.filter_if map (not % SSet.is_subterm var) - (** For all the elements in the removed terms set, it moves the mapped value to the new root. *) + (** For all the elements in the removed terms set, it moves the mapped value to the new root. + Returns new map and new union-find*) let remove_terms_containing_variable_from_map (part, map) removed_terms_set new_parents_map = - let remove_from_map term map = + let remove_from_map term (map, part) = match LMap.find_opt term map with - | None -> map + | None -> map, part | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) match find_new_root new_parents_map part term with - | None -> LMap.remove term map - | Some (new_root, new_offset) -> LMap.shift new_root new_offset term map - in SSet.fold remove_from_map removed_terms_set map + | None -> LMap.remove term map, part + | Some (new_root, new_offset, part) -> LMap.shift new_root new_offset term map, part + in SSet.fold remove_from_map removed_terms_set (map, part) (** Remove terms from the data structure. It removes all terms for which "var" is a subterm, @@ -822,9 +836,9 @@ module CongruenceClosure (Var : Val) = struct remove_terms_containing_variable_from_uf cc.part removed_terms_set map_of_children in let new_map = remove_subterms_from_mapped_values cc.map var - in let new_map = + in let new_map, new_part = remove_terms_containing_variable_from_map (new_part, new_map) removed_terms_set new_parents_map - in let min_repr = MRMap.compute_minimal_representatives (new_part, new_set, new_map) + in let min_repr, new_part = MRMap.compute_minimal_representatives (new_part, new_set, new_map) in {part = new_part; set = new_set; map = new_map; min_repr = min_repr} end From 8fd4f2d24e882cf5a9b8798955709520f48ee181 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Apr 2024 16:17:09 +0200 Subject: [PATCH 027/323] implemented leq --- src/cdomains/weaklyRelationalPointerDomain.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index c2024eafa0..266ad19b12 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -60,8 +60,6 @@ module D : Lattice.S = struct let is_top = function None -> false | Some cc -> TUF.is_empty cc.part - let leq x y = false - let join a b = a let widen = join @@ -74,6 +72,7 @@ module D : Lattice.S = struct | res -> Some res | exception Unsat -> None + let leq x y = equal (meet x y) x let narrow = meet From d3fd14867155d0a19774f2cde0f57b78a36e4c75 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Apr 2024 17:18:01 +0200 Subject: [PATCH 028/323] set name of analysis to wrpointer --- src/analyses/weaklyRelationalPointerAnalysis.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 0b435521d3..278276c370 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -16,7 +16,7 @@ struct module D = D module C = D - let name () = "weakly rlational pointer analysis" + let name () = "wrpointer" let startstate v = D.top() From e0e502d783cc9b8245e1f020bf1755782e372233 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Apr 2024 10:21:00 +0200 Subject: [PATCH 029/323] fix bug when inserting elements in the data structure --- src/cdomains/congruenceClosure.ml | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6ec90d8115..7b541c51d9 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -24,8 +24,6 @@ end module UnionFind (Val: Val) = struct module ValMap = ValMap(Val) - let hash_ref x y = 3 - (** (value * offset) ref * size of equivalence class *) type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] @@ -197,6 +195,7 @@ module UnionFind (Val: Val) = struct s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class ^ "\n") "" (get_eq_classes uf) ^ "\n" + end module LookupMap (T: Val) = struct @@ -511,7 +510,8 @@ module CongruenceClosure (Var : Val) = struct (LMap.zmap_bindings imap)) else None) (LMap.bindings map) - (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) *) + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) + Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = let normalize_equality (t1, t2, z) = @@ -666,20 +666,19 @@ module CongruenceClosure (Var : Val) = struct let v,z,part = TUF.find cc.part t in (v,z), {part = part; set = cc.set; map = cc.map; min_repr = cc.min_repr}, [] else let set = SSet.add t cc.set in + let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in match t with - | Addr a -> let part = LMap.add t ((t, Z.zero),1) cc.part in - let min_repr = LMap.add t (t, Z.zero) cc.min_repr in + | Addr a -> let part = TUF.ValMap.add t ((t, Z.zero),1) cc.part in (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in match LMap.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> let v,z,part = TUF.find cc.part v' in - (v,z), {part = part; set = cc.set; map = cc.map; min_repr = cc.min_repr}, queue - (* TODO don't we need a union here? *) + | Some v' -> let v2,z2,part = TUF.find cc.part v' in + let part = LMap.add t ((t, Z.zero),1) part in + (v2,z2), closure {part = part; set = set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr = min_repr} [(t, v', Z.zero)], v::queue | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let part = LMap.add t ((t, Z.zero),1) cc.part in - let min_repr = LMap.add t (t, Z.zero) cc.min_repr in - (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, queue + (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, v::queue (** Add a term to the data structure. From 98797cf7cad6f6712da4a3fcaf5000fdce362cc6 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Apr 2024 14:52:46 +0200 Subject: [PATCH 030/323] implemented parsing cil expressions --- .../weaklyRelationalPointerAnalysis.ml | 28 ++++-- src/cdomains/congruenceClosure.ml | 96 ++++++++++++++++--- src/cdomains/weaklyRelationalPointerDomain.ml | 6 +- tests/regression/79-wrpointer/01-simple.c | 13 +++ 4 files changed, 123 insertions(+), 20 deletions(-) create mode 100644 tests/regression/79-wrpointer/01-simple.c diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 278276c370..33abcfe294 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -1,4 +1,4 @@ -(** A Weakly-Relational Pointer Analysis.. *) +(** A Weakly-Relational Pointer Analysis..([wrpointer])*) (** TODO description *) @@ -8,20 +8,36 @@ open Analyses open WeaklyRelationalPointerDomain +module Operations = +struct + include CongruenceClosure + module D = D + let assign (t:D.domain) lval expr = + match t with + | None -> None + | Some t -> + match D.T.from_lval lval, D.T.from_cil expr with + | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> + D.meet_conjs_opt t [Equal (lterm, term, offset)] + | _ -> Some t + +end + (* module M = Messages module VS = SetDomain.Make (CilType.Varinfo) *) -module Spec : Spec = +module Spec : MCPSpec = struct include DefaultSpec - module D = D + include Operations module C = D let name () = "wrpointer" - let startstate v = D.top() - let exitstate v = D.top() - let assign ctx var expr = D.top() + + let assign ctx var expr = + assign ctx.local var expr + let branch ctx expr neg = D.top() let body ctx f = D.top() diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7b541c51d9..c7278fc736 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1,6 +1,7 @@ (** OCaml implementation of a quantitative congruence closure. *) open Batteries +open GoblintCil module type Val = sig type t @@ -286,7 +287,7 @@ end exception Unsat type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] -type 'v prop = Eq of 'v term * 'v term * Z.t | Neq of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] +type 'v prop = Equal of 'v term * 'v term * Z.t | Nequal of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] module Term(Var:Val) = struct type t = Var.t term [@@deriving eq, ord, hash] @@ -297,12 +298,77 @@ module Term(Var:Val) = struct | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" + + (**Returns an integer from a cil expression and None if the expression is not an integer. *) + let rec z_from_exp = function + | Const (CInt (i, _, _)) -> Some i + | UnOp _ + | BinOp _-> (*because we performed constant folding*)None + | _ -> None + + (**Returns an integer from a cil offset and None if the offset is not an integer. *) + let rec from_offset = function + | NoOffset -> Some Z.zero + | Field (fieldinfo, offset) -> (*TODO... ?*)None + | Index (exp, offset) -> match z_from_exp exp, from_offset offset with + | Some c1, Some c2 -> Some Z.(c1 + c2) + | _ -> None + + (**Returns Some term, Some offset or None, None if the expression can't be described with our analysis.*) + let rec from_cil = function + | Const c -> None, z_from_exp (Const c) + | Lval lval -> from_lval lval + | AlignOf _ + | AlignOfE _ + | StartOf _ -> (*no idea*) None, None + | AddrOf (Var var, NoOffset) -> Some (Addr var), Some Z.zero + | AddrOf (Mem exp, NoOffset) -> from_cil exp + | UnOp (op,exp,typ)-> begin match op with + | Neg -> begin match from_cil exp with + | None, Some off -> None, Some Z.(-off) + | _ -> None, None + end + | _ -> None, None + end + | BinOp (binop, exp1, exp2, typ)-> begin match binop with + | PlusA + | PlusPI + | IndexPI -> begin match from_cil exp1, from_cil exp2 with + | (None, Some off1), (Some term, Some off2) + | (Some term, Some off1), (None, Some off2) -> Some term, Some Z.(off1 + off2) + | _ -> None, None + end + | MinusA + | MinusPI + | MinusPP -> begin match from_cil exp1, from_cil exp2 with + | (Some term, Some off1), (None, Some off2) -> Some term, Some Z.(off1 - off2) + | _ -> None, None + end + | Eq -> None, None + | Ne -> None, None + | _ -> None, None + end + | CastE (typ, exp)-> (*TODO*)None, None + | AddrOf lval -> (*TODO*)None, None + | _ -> None, None + and from_lval = function + | (Var var, offset) -> begin match from_offset offset with + | None -> None, None + | Some off -> Some (Deref (Addr var, Z.zero)), Some off + end + | (Mem exp, offset) -> + begin match from_cil exp, from_offset offset with + | (Some term, Some offset), Some z_offset -> Some (Deref (term, offset)), Some z_offset + | _ -> None, None + end + + let from_cil = from_cil % Cil.constFold false + + end (** Quantitative congruence closure on terms *) module CongruenceClosure (Var : Val) = struct - - module T = Term(Var) module TUF = UnionFind (T) @@ -336,8 +402,8 @@ module CongruenceClosure (Var : Val) = struct subterms_of_term (set, map) t' let subterms_of_prop (set,map) = function - | Eq (t1,t2,_) - | Neq (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 + | Equal (t1,t2,_) + | Nequal (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list @@ -490,10 +556,10 @@ module CongruenceClosure (Var : Val) = struct [@@deriving eq, ord] let string_of_prop = function - | Eq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 - | Eq (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 - | Neq (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 - | Neq (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 + | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 + | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 + | Nequal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 + | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 let show_conj list = List.fold_left (fun s d -> s ^ "\t" ^ string_of_prop d ^ "\n") "" list @@ -516,7 +582,7 @@ module CongruenceClosure (Var : Val) = struct let get_normal_form cc = let normalize_equality (t1, t2, z) = if t1 = t2 && Z.(compare z zero) = 0 then None else - Some (Eq (t1, t2, z)) in + Some (Equal (t1, t2, z)) in let conjunctions_of_atoms = let atoms = SSet.get_atoms cc.set in List.filter_map (fun atom -> @@ -626,6 +692,7 @@ module CongruenceClosure (Var : Val) = struct - `min_repr` maps each equivalence class to its minimal representative. + Throws "Unsat" if a contradiction is found. *) let closure cc conjs = let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in @@ -635,8 +702,8 @@ module CongruenceClosure (Var : Val) = struct (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) let split conj = List.fold_left (fun (pos,neg) -> function - | Eq (t1,t2,r) -> ((t1,t2,r)::pos,neg) - | Neq(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj + | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg) + | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = @@ -705,6 +772,11 @@ module CongruenceClosure (Var : Val) = struct let cc = insert_set cc (fst (SSet.subterms_of_conj conjs)) in closure cc (fst (split conjs)) + let meet_conjs_opt cc conjs = + match meet_conjs cc conjs with + | exception Unsat -> None + | t -> Some t + (** Returns true if t1 and t2 are equivalent. *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 266ad19b12..25dcf7ad26 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -3,16 +3,18 @@ open Batteries open GoblintCil open CongruenceClosure +module Var = CilType.Varinfo +(* module Var: Val = struct type t = varinfo let compare = compare (* TODO *) let show v = v.vname (* TODO *) let hash x = 3 (* TODO *) let equal x y = (x = y) (* TODO *) -end +end *) -module D : Lattice.S = struct +module D = struct include Printable.StdLeaf include CongruenceClosure(Var) diff --git a/tests/regression/79-wrpointer/01-simple.c b/tests/regression/79-wrpointer/01-simple.c new file mode 100644 index 0000000000..4a860a535c --- /dev/null +++ b/tests/regression/79-wrpointer/01-simple.c @@ -0,0 +1,13 @@ +// PARAM: --set ana.activated[+] wrpointer +#include + +void main(void) { + int *i; + int **j; + int *k; + i = *(j + 3); + *j = k; + + __goblint_check(i == *(j + 3)); + __goblint_check(*j == k); +} From 8f8fa82bedccde514762ce68c6814983bf39427e Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Apr 2024 14:55:11 +0200 Subject: [PATCH 031/323] implemented simple case of assignment --- src/analyses/weaklyRelationalPointerAnalysis.ml | 2 +- src/cdomains/congruenceClosure.ml | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 33abcfe294..7c35393d77 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -18,7 +18,7 @@ struct | Some t -> match D.T.from_lval lval, D.T.from_cil expr with | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> - D.meet_conjs_opt t [Equal (lterm, term, offset)] + D.meet_conjs_opt (D.insert_set (D.remove_terms_containing_variable t lterm) (D.SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] | _ -> Some t end diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c7278fc736..bd7365c9a4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -733,12 +733,13 @@ module CongruenceClosure (Var : Val) = struct let v,z,part = TUF.find cc.part t in (v,z), {part = part; set = cc.set; map = cc.map; min_repr = cc.min_repr}, [] else let set = SSet.add t cc.set in - let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in match t with | Addr a -> let part = TUF.ValMap.add t ((t, Z.zero),1) cc.part in + let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in + let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,part = TUF.find cc.part v' in let part = LMap.add t ((t, Z.zero),1) part in From 66752a2d245654804f016e6b3a738d504a712c66 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Apr 2024 10:12:28 +0200 Subject: [PATCH 032/323] implement working dummy analysis --- .../weaklyRelationalPointerAnalysis.ml | 23 +++++++++++-------- src/cdomains/congruenceClosure.ml | 4 ++-- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 7c35393d77..d48fa2e2e0 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -10,7 +10,6 @@ open WeaklyRelationalPointerDomain module Operations = struct - include CongruenceClosure module D = D let assign (t:D.domain) lval expr = match t with @@ -28,29 +27,33 @@ end module Spec : MCPSpec = struct include DefaultSpec + include Analyses.IdentitySpec include Operations module C = D let name () = "wrpointer" - let startstate v = D.top() - let exitstate v = D.top() + let startstate v = D.empty() + let exitstate v = D.empty() let assign ctx var expr = assign ctx.local var expr - let branch ctx expr neg = D.top() + let branch ctx expr neg = ctx.local - let body ctx f = D.top() - let return ctx exp_opt f = D.top() + let body ctx f = ctx.local + let return ctx exp_opt f = ctx.local let special ctx var_opt v exprs = D.top() - let enter ctx var_opt f exprs = [] + let enter ctx var_opt f exprs = [ctx.local, ctx.local] let combine_env ctx var_opt expr f exprs t_context_opt t ask = t - let combine_assign ctx var_opt expr f exprs t_context_opt t ask = t + let combine_assign ctx var_opt expr f exprs t_context_opt t ask = ctx.local - let threadenter ctx ~multiple var_opt v exprs = [] - let threadspawn ctx ~multiple var_opt v exprs ctx2 = C.top() + let threadenter ctx ~multiple var_opt v exprs = [ctx.local] + let threadspawn ctx ~multiple var_opt v exprs ctx2 = ctx.local end + +let _ = + MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index bd7365c9a4..8b69e720e5 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -300,7 +300,7 @@ module Term(Var:Val) = struct | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" (**Returns an integer from a cil expression and None if the expression is not an integer. *) - let rec z_from_exp = function + let z_from_exp = function | Const (CInt (i, _, _)) -> Some i | UnOp _ | BinOp _-> (*because we performed constant folding*)None @@ -562,7 +562,7 @@ module CongruenceClosure (Var : Val) = struct | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 let show_conj list = List.fold_left - (fun s d -> s ^ "\t" ^ string_of_prop d ^ "\n") "" list + (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list let print_conj = print_string % show_conj From 500399ace80b7778916f627618dfbedb1e198098 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Apr 2024 11:49:01 +0200 Subject: [PATCH 033/323] generalized removing predicates --- .../weaklyRelationalPointerAnalysis.ml | 18 ++++--- src/cdomains/congruenceClosure.ml | 50 +++++++++++-------- 2 files changed, 39 insertions(+), 29 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index d48fa2e2e0..23a2482752 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -12,13 +12,17 @@ module Operations = struct module D = D let assign (t:D.domain) lval expr = - match t with - | None -> None - | Some t -> - match D.T.from_lval lval, D.T.from_cil expr with - | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> - D.meet_conjs_opt (D.insert_set (D.remove_terms_containing_variable t lterm) (D.SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] - | _ -> Some t + match t with + | None -> (* The domain is bottom *)None + | Some t -> + match D.T.from_lval lval, D.T.from_cil expr with + (* Indefinite assignments *) + | (Some lterm, Some loffset), (None, _) -> Some (D.remove_terms_containing_variable t lterm) + + | (Some (Addr x), Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> + (* This is not even possible *) + D.meet_conjs_opt (D.insert_set (D.remove_terms_containing_variable t (Addr x)) (D.SSet.TSet.of_list [Addr x; term])) [Equal (Addr x, term, offset)] + | _ -> Some t (* TOD what if lhs is None? Just ignore? -> Not a good idea *) end diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 8b69e720e5..9602ecf27c 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -299,6 +299,11 @@ module Term(Var:Val) = struct | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" + (** Returns true if the first parameter is a subterm of the second one. *) + let rec is_subterm st term = equal st term || match term with + | Deref (t, _) -> is_subterm st t + | _ -> false + (**Returns an integer from a cil expression and None if the expression is not an integer. *) let z_from_exp = function | Const (CInt (i, _, _)) -> Some i @@ -389,11 +394,6 @@ module CongruenceClosure (Var : Val) = struct let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ "\n") set "" ^ "\n" - (** Returns true if the first parameter is a subterm of the second one. *) - let rec is_subterm st term = T.equal st term || match term with - | Deref (t, _) -> is_subterm st t - | _ -> false - let rec subterms_of_term (set,map) t = match t with | Addr _ -> (add t set, map) | Deref (t',z) -> @@ -422,17 +422,17 @@ module CongruenceClosure (Var : Val) = struct (** Parameters: - `(part, set)`: union find tree and set of subterms that are present in the union find data structure. - - `var`: variable that needs to be removed from the data structure. + - `predicate`: predicate that returns true for terms which need to be removed from the data structure. Returns: - - `new_set`: subset of `set` which contains the terms that do not have var as a subterm. - - `removed_terms_set`: subset of `set` which contains the terms that have var as a subterm. + - `new_set`: subset of `set` which contains the terms that do not have to be removed. + - `removed_terms_set`: subset of `set` which contains the terms that have to be removed. - `map_of_children`: maps each element of union find to its children in the union find tree. It is used in order to later remove these elements from the union find data structure. *) - let remove_terms_containing_variable (part, set) var = + let remove_terms (part, set) predicate = (* Adds `value` to the set that is in the `map` with key `term` *) let add_to_result el (new_set, removed_terms_set, map_of_children) = - let new_set, removed_terms_set = if is_subterm var el then new_set, add el removed_terms_set else add el new_set, removed_terms_set in + let new_set, removed_terms_set = if predicate el then new_set, add el removed_terms_set else add el new_set, removed_terms_set in let (uf_parent_ref, _) = TMap.find el part in let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent_ref) in (new_set, removed_terms_set, map_of_children) in @@ -809,12 +809,12 @@ module CongruenceClosure (Var : Val) = struct (* remove variables *) - (** Removes all terms containing a variable from the union find data structure. + (** Removes all terms in "removed_terms_set" from the union find data structure. Returns: - `part`: the updated union find tree - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. *) - let remove_terms_containing_variable_from_uf part removed_terms_set map_of_children = + let remove_terms_from_uf part removed_terms_set map_of_children = let find_not_removed_element set = match List.find (fun el -> not (SSet.mem el removed_terms_set)) set with | exception Not_found -> List.first set | t -> t @@ -881,13 +881,13 @@ module CongruenceClosure (Var : Val) = struct | Some (r, o, part) -> Some (r, Z.(o + new_offset), part) (** Removes all terms from the mapped values of this map, - if they contain `var` as a subterm. *) - let remove_subterms_from_mapped_values map var = - LMap.filter_if map (not % SSet.is_subterm var) + for which "predicate" is false. *) + let remove_terms_from_mapped_values map predicate = + LMap.filter_if map (not % predicate) (** For all the elements in the removed terms set, it moves the mapped value to the new root. Returns new map and new union-find*) - let remove_terms_containing_variable_from_map (part, map) removed_terms_set new_parents_map = + let remove_terms_from_map (part, map) removed_terms_set new_parents_map = let remove_from_map term (map, part) = match LMap.find_opt term map with | None -> map, part @@ -898,19 +898,25 @@ module CongruenceClosure (Var : Val) = struct in SSet.fold remove_from_map removed_terms_set (map, part) (** Remove terms from the data structure. - It removes all terms for which "var" is a subterm, + It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variable cc var = + let remove_terms cc predicate = (* first find all terms that need to be removed *) let new_set, removed_terms_set, map_of_children = - SSet.remove_terms_containing_variable (cc.part, cc.set) var + SSet.remove_terms (cc.part, cc.set) predicate in let new_part, new_parents_map = - remove_terms_containing_variable_from_uf cc.part removed_terms_set map_of_children + remove_terms_from_uf cc.part removed_terms_set map_of_children in let new_map = - remove_subterms_from_mapped_values cc.map var + remove_terms_from_mapped_values cc.map predicate in let new_map, new_part = - remove_terms_containing_variable_from_map (new_part, new_map) removed_terms_set new_parents_map + remove_terms_from_map (new_part, new_map) removed_terms_set new_parents_map in let min_repr, new_part = MRMap.compute_minimal_representatives (new_part, new_set, new_map) in {part = new_part; set = new_set; map = new_map; min_repr = min_repr} + (** Remove terms from the data structure. + It removes all terms for which "var" is a subterm, + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variable cc var = + remove_terms cc (T.is_subterm var) + end From 09e952f885bae66c7f61ec1dcc5bd321c1f90b41 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Apr 2024 17:20:38 +0200 Subject: [PATCH 034/323] fixed bug that came from removing the ref in the union find --- src/analyses/weaklyRelationalPointerAnalysis.ml | 11 +++++++---- src/cdomains/congruenceClosure.ml | 10 +++++++--- src/cdomains/weaklyRelationalPointerDomain.ml | 11 +++++++++++ 3 files changed, 25 insertions(+), 7 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 23a2482752..82ab4ff15f 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -16,13 +16,16 @@ struct | None -> (* The domain is bottom *)None | Some t -> match D.T.from_lval lval, D.T.from_cil expr with - (* Indefinite assignments *) - | (Some lterm, Some loffset), (None, _) -> Some (D.remove_terms_containing_variable t lterm) - + (* Indefinite assignment *) + | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t lterm) + (* Definite assignment *) | (Some (Addr x), Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> (* This is not even possible *) D.meet_conjs_opt (D.insert_set (D.remove_terms_containing_variable t (Addr x)) (D.SSet.TSet.of_list [Addr x; term])) [Equal (Addr x, term, offset)] - | _ -> Some t (* TOD what if lhs is None? Just ignore? -> Not a good idea *) + | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> + D.meet_conjs_opt (D.insert_set (D.remove_may_equal_terms t lterm) (D.SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] + (* invertibe assignement *) + | _ -> Some t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) end diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9602ecf27c..56f23a96d7 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -304,6 +304,8 @@ module Term(Var:Val) = struct | Deref (t, _) -> is_subterm st t | _ -> false + let may_be_equal t1 t2 = true + (**Returns an integer from a cil expression and None if the expression is not an integer. *) let z_from_exp = function | Const (CInt (i, _, _)) -> Some i @@ -369,7 +371,6 @@ module Term(Var:Val) = struct let from_cil = from_cil % Cil.constFold false - end (** Quantitative congruence closure on terms *) @@ -840,11 +841,11 @@ module CongruenceClosure (Var : Val) = struct let new_size, map_of_children = List.fold (fun (total_size, map_of_children) child -> (* update parent and offset *) - let _ = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in + let part = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in total_size + TUF.subtree_size part child, SSet.add_to_map_of_children child map_of_children new_root ) (0, map_of_children) remaining_children in (* Update new root -> set itself as new parent. *) - let _ = TUF.modify_parent part new_root (new_root, Z.zero) in + let part = TUF.modify_parent part new_root (new_root, Z.zero) in (* update size of equivalence class *) let part = TUF.change_size new_root part ((+) new_size) in (TUF.ValMap.remove t part, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) @@ -919,4 +920,7 @@ module CongruenceClosure (Var : Val) = struct let remove_terms_containing_variable cc var = remove_terms cc (T.is_subterm var) + let remove_may_equal_terms cc term = + remove_terms cc (T.may_be_equal term) + end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 25dcf7ad26..fab3df8d31 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -80,4 +80,15 @@ module D = struct let pretty_diff () (x,y) = Pretty.dprintf "" + let printXml f x = match x with + | Some x -> + BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\n\n" + (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) + (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.part))) + (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) + (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) + (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) + | None -> BatPrintf.fprintf f "\n\n\nnormal form\n\n\ntrue\n\n\n" + + end From 762b6a6e8e5f5b7af4263746741f3c15d1e73ce2 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Apr 2024 17:20:47 +0200 Subject: [PATCH 035/323] add some tests --- tests/regression/79-wrpointer/02-rel-simple.c | 58 +++++++++++++++++++ .../79-wrpointer/03-function-call.c | 15 +++++ .../regression/79-wrpointer/04-remove-vars.c | 21 +++++++ 3 files changed, 94 insertions(+) create mode 100644 tests/regression/79-wrpointer/02-rel-simple.c create mode 100644 tests/regression/79-wrpointer/03-function-call.c create mode 100644 tests/regression/79-wrpointer/04-remove-vars.c diff --git a/tests/regression/79-wrpointer/02-rel-simple.c b/tests/regression/79-wrpointer/02-rel-simple.c new file mode 100644 index 0000000000..84f284f9fb --- /dev/null +++ b/tests/regression/79-wrpointer/02-rel-simple.c @@ -0,0 +1,58 @@ +// PARAM: --set ana.activated[+] wrpointer +#include +#include +#include + +int main(void) { + int *i = (int *)malloc(sizeof(int)); + int ***j = (int ***)malloc(sizeof(int) * 4); + int **j2 = (int **)malloc(sizeof(int)); + int **j23 = (int **)malloc(sizeof(int)); + *j = j2; + *(j + 3) = j23; + int *j3 = (int *)malloc(sizeof(int)); + int *j33 = (int *)malloc(sizeof(int)); + *j2 = j3; + **(j + 3) = j33; + *j3 = 4; + *j33 = 5; + int *k = i; + *k = 3; + // j --> *j=j2 --> **j=j3 --> ***j=|4| + // (j+3) --> j23 --> j33 --> |5| + // k=i --> |3| + + printf("***j = %d\n", ***j); // 4 + printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + printf("*i = %d\n", *i); // 3 + printf("*k = %d\n", *k); // 3 + printf("\n"); + + i = **(j + 3); + + // j --> *j=j2 --> **j=j3 --> ***j=|4| + // (j+3) --> j23 --> j33=i --> |5| + // k --> |3| + + printf("***j = %d\n", ***j); // 4 + printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + printf("*i = %d\n", *i); // 5 + printf("*k = %d\n", *k); // 3 + printf("\n"); + + *j = &k; + + // j2 --> j3 --> |4| + // (j+3) --> j23 --> j33=i --> |5| + // j --> *j --> k --> |3| + + printf("***j = %d\n", ***j); // 3 + printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + printf("*i = %d\n", *i); // 5 + printf("*k = %d\n", *k); // 3 + printf("**j2 = %d\n", **j2); // 4 + + // not assignable: &k = *j; + + return 0; +} diff --git a/tests/regression/79-wrpointer/03-function-call.c b/tests/regression/79-wrpointer/03-function-call.c new file mode 100644 index 0000000000..ea47d54e21 --- /dev/null +++ b/tests/regression/79-wrpointer/03-function-call.c @@ -0,0 +1,15 @@ +// PARAM: --set ana.activated[+] wrpointer + +#include + +int *f(int **a, int *b) { return *a; } + +int main(void) { + int *i; + int **j; + int *k = f(j, i); + + __goblint_check(k == *j); + + return 0; +} diff --git a/tests/regression/79-wrpointer/04-remove-vars.c b/tests/regression/79-wrpointer/04-remove-vars.c new file mode 100644 index 0000000000..d40022f930 --- /dev/null +++ b/tests/regression/79-wrpointer/04-remove-vars.c @@ -0,0 +1,21 @@ +// PARAM: --set ana.activated[+] wrpointer +#include +#include + +int *f(int **j) { + int *i = (int *)malloc(sizeof(int)); + + *j = i; + + return i; +} + +int main(void) { + int *i; + int **j; + int *k = f(j); + + __goblint_check(k == *j); + + return 0; +} From e4c10c42e8e17ea866425afd7d8e0c73639990cc Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Apr 2024 18:29:41 +0200 Subject: [PATCH 036/323] implemented enter --- .../weaklyRelationalPointerAnalysis.ml | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 82ab4ff15f..b6f632af6d 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -6,12 +6,13 @@ open GoblintCil open Pretty *) open Analyses +open GoblintCil open WeaklyRelationalPointerDomain module Operations = struct module D = D - let assign (t:D.domain) lval expr = + let assign_lval (t:D.domain) lval expr = match t with | None -> (* The domain is bottom *)None | Some t -> @@ -24,7 +25,7 @@ struct D.meet_conjs_opt (D.insert_set (D.remove_terms_containing_variable t (Addr x)) (D.SSet.TSet.of_list [Addr x; term])) [Equal (Addr x, term, offset)] | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> D.meet_conjs_opt (D.insert_set (D.remove_may_equal_terms t lterm) (D.SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] - (* invertibe assignement *) + (* invertibe assignment *) | _ -> Some t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) end @@ -43,16 +44,23 @@ struct let exitstate v = D.empty() let assign ctx var expr = - assign ctx.local var expr + assign_lval ctx.local var expr let branch ctx expr neg = ctx.local - let body ctx f = ctx.local + let body ctx f = ctx.local (*DONE*) + let return ctx exp_opt f = ctx.local let special ctx var_opt v exprs = D.top() - let enter ctx var_opt f exprs = [ctx.local, ctx.local] + let enter ctx var_opt f args = + let state = ctx.local in + let arg_assigns = + GobList.combine_short f.sformals args + in + let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (Var var, NoOffset) exp) state arg_assigns in + [ctx.local, new_state] (*TODO remove callee vars?*) let combine_env ctx var_opt expr f exprs t_context_opt t ask = t let combine_assign ctx var_opt expr f exprs t_context_opt t ask = ctx.local From 3b5ae99311a7abd92e5dd29ab4390d738f499c7f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Apr 2024 11:14:49 +0200 Subject: [PATCH 037/323] fixed bug in remove_from_uf and started using MayPointToQuery to find unequal pointers --- .../weaklyRelationalPointerAnalysis.ml | 20 +++++---- src/cdomains/congruenceClosure.ml | 34 ++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 41 +++++++++++++------ 3 files changed, 53 insertions(+), 42 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index b6f632af6d..cf9affb41b 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -8,23 +8,24 @@ open Analyses open GoblintCil open WeaklyRelationalPointerDomain +module CC = CongruenceClosure +open CC.CongruenceClosure(Var) module Operations = struct - module D = D - let assign_lval (t:D.domain) lval expr = + let assign_lval (t:D.domain) ask lval expr = match t with | None -> (* The domain is bottom *)None | Some t -> - match D.T.from_lval lval, D.T.from_cil expr with + match T.from_lval lval, T.from_cil expr with (* Indefinite assignment *) - | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t lterm) + | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t ask lterm) (* Definite assignment *) | (Some (Addr x), Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> (* This is not even possible *) - D.meet_conjs_opt (D.insert_set (D.remove_terms_containing_variable t (Addr x)) (D.SSet.TSet.of_list [Addr x; term])) [Equal (Addr x, term, offset)] + meet_conjs_opt (insert_set (D.remove_terms_containing_variable t (Addr x)) (SSet.TSet.of_list [Addr x; term])) [Equal (Addr x, term, offset)] | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> - D.meet_conjs_opt (D.insert_set (D.remove_may_equal_terms t lterm) (D.SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] + meet_conjs_opt (insert_set (D.remove_may_equal_terms t ask lterm) (SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] (* invertibe assignment *) | _ -> Some t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) @@ -37,14 +38,17 @@ struct include DefaultSpec include Analyses.IdentitySpec include Operations + module D = D module C = D let name () = "wrpointer" let startstate v = D.empty() let exitstate v = D.empty() + let query _ (type a) (q: a Queries.t) = Queries.Result.top q + let assign ctx var expr = - assign_lval ctx.local var expr + assign_lval ctx.local (ask_of_ctx ctx) var expr let branch ctx expr neg = ctx.local @@ -59,7 +63,7 @@ struct let arg_assigns = GobList.combine_short f.sformals args in - let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (Var var, NoOffset) exp) state arg_assigns in + let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) state arg_assigns in [ctx.local, new_state] (*TODO remove callee vars?*) let combine_env ctx var_opt expr f exprs t_context_opt t ask = t diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 56f23a96d7..0b74d0f239 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -304,7 +304,11 @@ module Term(Var:Val) = struct | Deref (t, _) -> is_subterm st t | _ -> false - let may_be_equal t1 t2 = true + let rec to_cil = function + | Addr v -> AddrOf (Var v, NoOffset) + | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset) + | Deref (t, z) when Z.equal z Z.zero -> Lval (Mem (to_cil t), NoOffset) + | Deref (t, z) -> Lval (Mem (to_cil t), Index (Const (CInt (z, ILongLong, None)), NoOffset)) (**Returns an integer from a cil expression and None if the expression is not an integer. *) let z_from_exp = function @@ -419,8 +423,12 @@ module CongruenceClosure (Var : Val) = struct | None -> TMap.add term [value] map | Some list -> TMap.add term (value::list) map - (* remove variables *) + let remove_from_map_of_children parent child map = + match List.remove (TMap.find parent map) child with + | [] -> TMap.remove parent map + | new_children -> TMap.add parent new_children map + (* remove variables *) (** Parameters: - `(part, set)`: union find tree and set of subterms that are present in the union find data structure. - `predicate`: predicate that returns true for terms which need to be removed from the data structure. @@ -787,17 +795,6 @@ module CongruenceClosure (Var : Val) = struct let (v2,r2),cc = insert cc t2 in (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), cc) - (** - Returns true if t1 and t2 are not equivalent. - *) - let neq_query cc _ (t1,t2,_) = - let (v1,r1),cc = insert cc t1 in - let (v2,r2),_ = insert cc t2 in - if T.compare v1 v2 = 0 then - if r1 = r2 then false - else true - else false (* TODO disequalities *) - (** Add proposition t1 = t2 + r to the data structure. *) @@ -826,6 +823,8 @@ module CongruenceClosure (Var : Val) = struct (* t has no children, so we can safely delete the element from the data structure *) (* we just need to update the size on the whole path from here to the root *) let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (TUF.parent part t) new_parents_map in + let parent = fst (TUF.parent part t) in + let map_of_children = if TUF.is_root part t then map_of_children else SSet.remove_from_map_of_children parent t map_of_children in (TUF.ValMap.remove t (TUF.change_size t part pred), new_parents_map, map_of_children) | Some children -> let map_of_children = LMap.remove t map_of_children in @@ -914,13 +913,4 @@ module CongruenceClosure (Var : Val) = struct in let min_repr, new_part = MRMap.compute_minimal_representatives (new_part, new_set, new_map) in {part = new_part; set = new_set; map = new_map; min_repr = min_repr} - (** Remove terms from the data structure. - It removes all terms for which "var" is a subterm, - while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variable cc var = - remove_terms cc (T.is_subterm var) - - let remove_may_equal_terms cc term = - remove_terms cc (T.may_be_equal term) - end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index fab3df8d31..2199a8435e 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -2,29 +2,38 @@ open Batteries open GoblintCil -open CongruenceClosure module Var = CilType.Varinfo +module CC = CongruenceClosure +open CC.CongruenceClosure(Var) +module M = Messages -(* -module Var: Val = struct - type t = varinfo - let compare = compare (* TODO *) - let show v = v.vname (* TODO *) - let hash x = 3 (* TODO *) - let equal x y = (x = y) (* TODO *) -end *) +(**Find out if two addresses are not equal by using the MayPointTo query*) +module Disequalities = struct + + module AD = AddressDomain.AddressSet (PreValueDomain.Mval) (ValueDomain.ID) + + let query_neq (ask:Queries.ask) t1 t2 = + let exp1 = T.to_cil t1 in + let exp2 = T.to_cil t2 in + let mpt1 = ask.f (MayPointTo exp1) in + let mpt2 = ask.f (MayPointTo exp2) in + AD.is_bot (AD.meet mpt1 mpt2) + + (**Find out if two addresses may be equal by using the MayPointTo query*) + let may_be_equal ask t1 t2 = not (query_neq ask t1 t2) + +end module D = struct include Printable.StdLeaf - include CongruenceClosure(Var) type domain = t option type t = domain (** Convert to string *) let show x = match x with - | None -> "⊥" + | None -> "⊥\n" | Some x -> show_conj (get_normal_form x) let show_all = function @@ -72,7 +81,7 @@ module D = struct let a_conj = get_normal_form a in match meet_conjs b a_conj with | res -> Some res - | exception Unsat -> None + | exception CC.Unsat -> None let leq x y = equal (meet x y) x @@ -90,5 +99,13 @@ module D = struct (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) | None -> BatPrintf.fprintf f "\n\n\nnormal form\n\n\ntrue\n\n\n" + (** Remove terms from the data structure. + It removes all terms for which "var" is a subterm, + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variable cc var = + remove_terms cc (T.is_subterm var) + + let remove_may_equal_terms cc ask term = + remove_terms cc (Disequalities.may_be_equal ask term) end From 47cb676a39d317b1bc4fdc35d1f15d184108cbfe Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Apr 2024 16:29:53 +0200 Subject: [PATCH 038/323] fixed bug when removing terms --- src/cdomains/congruenceClosure.ml | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 0b74d0f239..9d3abb6741 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -2,6 +2,7 @@ open Batteries open GoblintCil +module M = Messages module type Val = sig type t @@ -304,11 +305,15 @@ module Term(Var:Val) = struct | Deref (t, _) -> is_subterm st t | _ -> false - let rec to_cil = function - | Addr v -> AddrOf (Var v, NoOffset) - | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset) - | Deref (t, z) when Z.equal z Z.zero -> Lval (Mem (to_cil t), NoOffset) - | Deref (t, z) -> Lval (Mem (to_cil t), Index (Const (CInt (z, ILongLong, None)), NoOffset)) + let to_cil_offset z = if Z.equal z Z.zero then NoOffset + else Index (Const (CInt (z, ILongLong, None)), NoOffset) + + let rec to_cil off t = + let cil_off = to_cil_offset off in + match t with + | Addr v -> AddrOf (Var v, cil_off) + | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, cil_off) + | Deref (t, z) -> Lval (Mem (to_cil z t), cil_off) (**Returns an integer from a cil expression and None if the expression is not an integer. *) let z_from_exp = function @@ -564,6 +569,15 @@ module CongruenceClosure (Var : Val) = struct min_repr: MRMap.t} [@@deriving eq, ord] + let show_all x = "Union Find partition:\n" ^ + (TUF.show_uf x.part) + ^ "\nSubterm set:\n" + ^ (SSet.show_set x.set) + ^ "\nLookup map/transitions:\n" + ^ (LMap.show_map x.map) + ^ "\nMinimal representatives:\n" + ^ (MRMap.show_min_rep x.min_repr) + let string_of_prop = function | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 @@ -741,14 +755,16 @@ module CongruenceClosure (Var : Val) = struct if SSet.mem t cc.set then let v,z,part = TUF.find cc.part t in (v,z), {part = part; set = cc.set; map = cc.map; min_repr = cc.min_repr}, [] - else let set = SSet.add t cc.set in + else match t with | Addr a -> let part = TUF.ValMap.add t ((t, Z.zero),1) cc.part in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in + let set = SSet.add t cc.set in (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in + let set = SSet.add t cc.set in match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,part = TUF.find cc.part v' in let part = LMap.add t ((t, Z.zero),1) part in @@ -762,7 +778,6 @@ module CongruenceClosure (Var : Val) = struct Returns (reference variable, offset), updated (part, set, map, min_repr) *) let insert cc t = let v, cc, queue = insert_no_min_repr cc t in - (* the queue has at most one element, so there is no need to sort it *) let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in v, {part = part; set = cc.set; map = cc.map; min_repr = min_repr} From 06675a896f0857fa649fc358cf1d3f5f858459ba Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Apr 2024 17:03:45 +0200 Subject: [PATCH 039/323] fixed to_cil function --- src/cdomains/congruenceClosure.ml | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9d3abb6741..1c8989d5e4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -305,15 +305,20 @@ module Term(Var:Val) = struct | Deref (t, _) -> is_subterm st t | _ -> false - let to_cil_offset z = if Z.equal z Z.zero then NoOffset - else Index (Const (CInt (z, ILongLong, None)), NoOffset) + let rec term_depth = function + | Addr _ -> 0 + | Deref (t, _) -> 1 + term_depth t + + let default_int_type = IInt + let rec default_pointer_type n = if n = 0 then TInt (default_int_type, []) else TPtr (default_pointer_type (n-1), []) + let to_cil_constant z = Const (CInt (z, default_int_type, Some (Z.to_string z))) let rec to_cil off t = - let cil_off = to_cil_offset off in - match t with - | Addr v -> AddrOf (Var v, cil_off) - | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, cil_off) - | Deref (t, z) -> Lval (Mem (to_cil z t), cil_off) + let cil_t = match t with + | Addr v -> AddrOf (Var v, NoOffset) + | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset) + | Deref (t, z) -> Lval (Mem (to_cil z t), NoOffset) + in if Z.(equal zero off) then cil_t else BinOp (PlusPI, cil_t, to_cil_constant off, default_pointer_type (term_depth t)) (**Returns an integer from a cil expression and None if the expression is not an integer. *) let z_from_exp = function From f28ccc14601a30c5da08edea32facf7a8a83e5eb Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Apr 2024 17:04:27 +0200 Subject: [PATCH 040/323] started implementing may_be_equal --- src/cdomains/weaklyRelationalPointerDomain.ml | 48 ++++++++++++------- 1 file changed, 30 insertions(+), 18 deletions(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 2199a8435e..cc781268fe 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -4,7 +4,7 @@ open Batteries open GoblintCil module Var = CilType.Varinfo module CC = CongruenceClosure -open CC.CongruenceClosure(Var) +include CC.CongruenceClosure(Var) module M = Messages (**Find out if two addresses are not equal by using the MayPointTo query*) @@ -12,16 +12,33 @@ module Disequalities = struct module AD = AddressDomain.AddressSet (PreValueDomain.Mval) (ValueDomain.ID) - let query_neq (ask:Queries.ask) t1 t2 = - let exp1 = T.to_cil t1 in - let exp2 = T.to_cil t2 in + (**Find out if two addresses are definitely not equal by using the MayPointTo query*) + let query_neq (ask:Queries.ask) t1 t2 off = + let exp1 = T.to_cil Z.zero t1 in + let exp2 = T.to_cil off t2 in let mpt1 = ask.f (MayPointTo exp1) in let mpt2 = ask.f (MayPointTo exp2) in AD.is_bot (AD.meet mpt1 mpt2) - (**Find out if two addresses may be equal by using the MayPointTo query*) - let may_be_equal ask t1 t2 = not (query_neq ask t1 t2) - + (**Returns true iff by assigning to t1, the value of t2 doesn't change. *) + let rec may_be_equal ask part t1 t2 = + match t1, t2 with + | CC.Deref (t, z), CC.Deref (v, z') -> print_string "- "; + let (q', z1') = TUF.find_no_pc part v in + let (q, z1) = TUF.find_no_pc part t in + (* If they are in the same equivalence class but with a different offset, then they are not equal *) + ( + not (T.equal q' q && not(Z.(equal z (z' + z1 - z1')))) + (* or if we know that they are not equal according to the query MayPointTo*) + && + not (query_neq ask q q' Z.(z' - z + z1 - z1')) + ) + || (may_be_equal ask part t1 v) + | CC.Deref _, _ -> print_string "-- ";false (*The value of addresses never change when we overwrite the memory*) + | CC.Addr _ , _ -> print_string "--- ";T.is_subterm t1 t2 + + let may_be_equal ask part t1 t2 = print_string "may_be_equal "; print_string (T.show t1); print_string " ";print_string (T.show t2); + let res = (may_be_equal ask part t1 t2) in print_string ": "; print_string (string_of_bool res); print_endline "";res end module D = struct @@ -38,20 +55,14 @@ module D = struct let show_all = function | None -> "⊥\n" - | Some x -> "Union Find partition:\n" ^ - (TUF.show_uf x.part) - ^ "\nSubterm set:\n" - ^ (SSet.show_set x.set) - ^ "\nLookup map/transitions:\n" - ^ (LMap.show_map x.map) - ^ "\nMinimal representatives:\n" - ^ (MRMap.show_min_rep x.min_repr) + | Some x -> show_all x include Printable.SimpleShow(struct type t = domain let show = show end) let name () = "wrpointer" - let equal x y = match x, y with + let equal x y = if M.tracing then M.trace "wrpointer" "equal.\nx=\n%s\ny=\n%s" (show_all x) (show_all y); + match x, y with | Some x, Some y -> (get_normal_form x = get_normal_form y) | None, None -> true @@ -71,7 +82,7 @@ module D = struct let is_top = function None -> false | Some cc -> TUF.is_empty cc.part - let join a b = a + let join a b = if M.tracing then M.trace "wrpointer" "JOIN";a let widen = join let meet a b = match a,b with (*TODO put in different file *) @@ -106,6 +117,7 @@ module D = struct remove_terms cc (T.is_subterm var) let remove_may_equal_terms cc ask term = - remove_terms cc (Disequalities.may_be_equal ask term) + let cc = (snd(insert cc term)) in + remove_terms cc (Disequalities.may_be_equal ask cc.part term) end From 807d6738298e117824cf09d323c39730b66a7c63 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 10 Apr 2024 14:09:46 +0200 Subject: [PATCH 041/323] fixed bug in assignment --- .../weaklyRelationalPointerAnalysis.ml | 25 ++++++++++++++++--- src/cdomains/congruenceClosure.ml | 6 +++-- 2 files changed, 26 insertions(+), 5 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index cf9affb41b..546ebb443d 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -13,11 +13,28 @@ open CC.CongruenceClosure(Var) module Operations = struct + let from_cil a = let res = T.from_cil a in + let string_res = match res with + | None,None -> "None, None" + | Some res,None -> (T.show res) ^", None" + | None, Some z -> "None, " ^Z.to_string z + | Some res, Some z -> (T.show res) ^", "^Z.to_string z in + if M.tracing then M.trace "wrpointer" "Converting rhs: <%a>. Plain expression: <%a>. Result: <%s>\n" d_exp a d_plainexp a string_res;res + + + let from_lval a = let res = T.from_lval a in + let string_res = match res with + | None,None -> "None, None" + | Some res,None -> (T.show res) ^", None" + | None, Some z -> "None, " ^Z.to_string z + | Some res, Some z -> (T.show res) ^", "^Z.to_string z in + if M.tracing then M.trace "wrpointer" "Converting lhs: <%a>. Plain lval: <%a>. Result: <%s>\n" d_lval a d_plainlval a string_res;res + let assign_lval (t:D.domain) ask lval expr = match t with | None -> (* The domain is bottom *)None | Some t -> - match T.from_lval lval, T.from_cil expr with + match from_lval lval, from_cil expr with (* Indefinite assignment *) | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t ask lterm) (* Definite assignment *) @@ -48,7 +65,8 @@ struct let query _ (type a) (q: a Queries.t) = Queries.Result.top q let assign ctx var expr = - assign_lval ctx.local (ask_of_ctx ctx) var expr + let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in + if M.tracing then M.trace "wrpointer" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res let branch ctx expr neg = ctx.local @@ -56,7 +74,7 @@ struct let return ctx exp_opt f = ctx.local - let special ctx var_opt v exprs = D.top() + let special ctx var_opt v exprs = ctx.local let enter ctx var_opt f args = let state = ctx.local in @@ -64,6 +82,7 @@ struct GobList.combine_short f.sformals args in let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) state arg_assigns in + if M.tracing then M.trace "wrpointer" "ENTER: result: %s\n" (D.show new_state); [ctx.local, new_state] (*TODO remove callee vars?*) let combine_env ctx var_opt expr f exprs t_context_opt t ask = t diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 1c8989d5e4..55824eb6ea 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -318,7 +318,7 @@ module Term(Var:Val) = struct | Addr v -> AddrOf (Var v, NoOffset) | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset) | Deref (t, z) -> Lval (Mem (to_cil z t), NoOffset) - in if Z.(equal zero off) then cil_t else BinOp (PlusPI, cil_t, to_cil_constant off, default_pointer_type (term_depth t)) + in if Z.(equal zero off) then cil_t else BinOp (PlusPI, cil_t, to_cil_constant off, default_pointer_type (term_depth t + 1)) (**Returns an integer from a cil expression and None if the expression is not an integer. *) let z_from_exp = function @@ -931,6 +931,8 @@ module CongruenceClosure (Var : Val) = struct in let new_map, new_part = remove_terms_from_map (new_part, new_map) removed_terms_set new_parents_map in let min_repr, new_part = MRMap.compute_minimal_representatives (new_part, new_set, new_map) - in {part = new_part; set = new_set; map = new_map; min_repr = min_repr} + in + if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n" (SSet.fold (fun t s -> s ^"; "^T.show t) removed_terms_set ""); + {part = new_part; set = new_set; map = new_map; min_repr = min_repr} end From 03840818074dd5bb6832ea9209cfec92514079f8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 10 Apr 2024 14:13:48 +0200 Subject: [PATCH 042/323] remove debug output --- .../weaklyRelationalPointerAnalysis.ml | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 546ebb443d..abcc119dbd 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -13,28 +13,11 @@ open CC.CongruenceClosure(Var) module Operations = struct - let from_cil a = let res = T.from_cil a in - let string_res = match res with - | None,None -> "None, None" - | Some res,None -> (T.show res) ^", None" - | None, Some z -> "None, " ^Z.to_string z - | Some res, Some z -> (T.show res) ^", "^Z.to_string z in - if M.tracing then M.trace "wrpointer" "Converting rhs: <%a>. Plain expression: <%a>. Result: <%s>\n" d_exp a d_plainexp a string_res;res - - - let from_lval a = let res = T.from_lval a in - let string_res = match res with - | None,None -> "None, None" - | Some res,None -> (T.show res) ^", None" - | None, Some z -> "None, " ^Z.to_string z - | Some res, Some z -> (T.show res) ^", "^Z.to_string z in - if M.tracing then M.trace "wrpointer" "Converting lhs: <%a>. Plain lval: <%a>. Result: <%s>\n" d_lval a d_plainlval a string_res;res - let assign_lval (t:D.domain) ask lval expr = match t with | None -> (* The domain is bottom *)None | Some t -> - match from_lval lval, from_cil expr with + match T.from_lval lval, T.from_cil expr with (* Indefinite assignment *) | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t ask lterm) (* Definite assignment *) From a834c29fabbfa8565c4fdf49829125ec7ff83baf Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 10 Apr 2024 17:07:55 +0200 Subject: [PATCH 043/323] implemented branching --- .../weaklyRelationalPointerAnalysis.ml | 29 ++++++- src/cdomains/congruenceClosure.ml | 85 +++++++++++++++---- 2 files changed, 95 insertions(+), 19 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index abcc119dbd..776a694fd1 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -17,7 +17,7 @@ struct match t with | None -> (* The domain is bottom *)None | Some t -> - match T.from_lval lval, T.from_cil expr with + match T.of_lval lval, T.of_cil expr with (* Indefinite assignment *) | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t ask lterm) (* Definite assignment *) @@ -29,6 +29,24 @@ struct (* invertibe assignment *) | _ -> Some t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) + + let branch_fn ctx e neg = + match ctx.local with + | None -> None + | Some st -> + let prop_list = T.prop_of_cil e neg in + let res = meet_conjs_opt st prop_list in + if D.is_bot res then raise Deadcode; + if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; neg: %s; prop_list: %s\n" + d_exp e (string_of_bool neg) (show_conj prop_list); + res + + let assert_fn ctx e refine = + if not refine then + ctx.local + else + branch_fn ctx e false + end (* module M = Messages @@ -51,13 +69,18 @@ struct let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in if M.tracing then M.trace "wrpointer" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res - let branch ctx expr neg = ctx.local + let branch ctx expr neg = branch_fn ctx expr neg let body ctx f = ctx.local (*DONE*) let return ctx exp_opt f = ctx.local - let special ctx var_opt v exprs = ctx.local + + let special ctx var_opt v exprs = + let desc = LibraryFunctions.find v in + match desc.special exprs, v.vname with + | Assert { exp; refine; _ }, _ -> assert_fn ctx exp refine + | _, _ -> ctx.local let enter ctx var_opt f args = let state = ctx.local in diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 55824eb6ea..d0ca328649 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -150,7 +150,7 @@ module UnionFind (Val: Val) = struct if Val.compare v' v = 0 then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") - else find_no_pc uf v' + else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare @@ -321,31 +321,31 @@ module Term(Var:Val) = struct in if Z.(equal zero off) then cil_t else BinOp (PlusPI, cil_t, to_cil_constant off, default_pointer_type (term_depth t + 1)) (**Returns an integer from a cil expression and None if the expression is not an integer. *) - let z_from_exp = function + let z_of_exp = function | Const (CInt (i, _, _)) -> Some i | UnOp _ | BinOp _-> (*because we performed constant folding*)None | _ -> None (**Returns an integer from a cil offset and None if the offset is not an integer. *) - let rec from_offset = function + let rec of_offset = function | NoOffset -> Some Z.zero | Field (fieldinfo, offset) -> (*TODO... ?*)None - | Index (exp, offset) -> match z_from_exp exp, from_offset offset with + | Index (exp, offset) -> match z_of_exp exp, of_offset offset with | Some c1, Some c2 -> Some Z.(c1 + c2) | _ -> None (**Returns Some term, Some offset or None, None if the expression can't be described with our analysis.*) - let rec from_cil = function - | Const c -> None, z_from_exp (Const c) - | Lval lval -> from_lval lval + let rec of_cil = function + | Const c -> None, z_of_exp (Const c) + | Lval lval -> of_lval lval | AlignOf _ | AlignOfE _ | StartOf _ -> (*no idea*) None, None | AddrOf (Var var, NoOffset) -> Some (Addr var), Some Z.zero - | AddrOf (Mem exp, NoOffset) -> from_cil exp + | AddrOf (Mem exp, NoOffset) -> of_cil exp | UnOp (op,exp,typ)-> begin match op with - | Neg -> begin match from_cil exp with + | Neg -> begin match of_cil exp with | None, Some off -> None, Some Z.(-off) | _ -> None, None end @@ -354,14 +354,14 @@ module Term(Var:Val) = struct | BinOp (binop, exp1, exp2, typ)-> begin match binop with | PlusA | PlusPI - | IndexPI -> begin match from_cil exp1, from_cil exp2 with + | IndexPI -> begin match of_cil exp1, of_cil exp2 with | (None, Some off1), (Some term, Some off2) | (Some term, Some off1), (None, Some off2) -> Some term, Some Z.(off1 + off2) | _ -> None, None end | MinusA | MinusPI - | MinusPP -> begin match from_cil exp1, from_cil exp2 with + | MinusPP -> begin match of_cil exp1, of_cil exp2 with | (Some term, Some off1), (None, Some off2) -> Some term, Some Z.(off1 - off2) | _ -> None, None end @@ -369,21 +369,74 @@ module Term(Var:Val) = struct | Ne -> None, None | _ -> None, None end - | CastE (typ, exp)-> (*TODO*)None, None + | CastE (typ, exp)-> of_cil exp | AddrOf lval -> (*TODO*)None, None | _ -> None, None - and from_lval = function - | (Var var, offset) -> begin match from_offset offset with + and of_lval = function + | (Var var, offset) -> begin match of_offset offset with | None -> None, None | Some off -> Some (Deref (Addr var, Z.zero)), Some off end | (Mem exp, offset) -> - begin match from_cil exp, from_offset offset with + begin match of_cil exp, of_offset offset with | (Some term, Some offset), Some z_offset -> Some (Deref (term, offset)), Some z_offset | _ -> None, None end - let from_cil = from_cil % Cil.constFold false + let of_cil = of_cil % Cil.constFold false + + let rec of_cil_neg neg e = match e with + | UnOp (op,exp,typ)-> + begin match op with + | Neg -> of_cil_neg (not neg) exp + | _ -> if neg then None, None else of_cil e + end + | _ -> if neg then None, None else of_cil e + + let map_z_opt op z = Tuple2.map2 (Option.map (op z)) + let rec two_terms_of_cil neg e = + let pos_t, neg_t = match e with + | UnOp (op,exp,typ)-> begin match op with + | Neg -> two_terms_of_cil (not neg) exp + | _ -> of_cil e, (None, Some Z.zero) + end + | BinOp (binop, exp1, exp2, typ)-> begin match binop with + | PlusA + | PlusPI + | IndexPI -> begin match of_cil exp1 with + | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil true exp2 in + map_z_opt Z.(+) off1 pos_t, neg_t + | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg true exp2 + | _ -> (None, None), (None, None) + end + | MinusA + | MinusPI + | MinusPP -> begin match of_cil exp1 with + | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil false exp2 in + map_z_opt Z.(+) off1 pos_t, neg_t + | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg false exp2 + | _ -> of_cil e, (None, Some Z.zero) + end + | _ -> of_cil e, (None, Some Z.zero) + end + | _ -> of_cil e, (None, Some Z.zero) + in if neg then neg_t, pos_t else pos_t, neg_t + + let rec prop_of_cil e negate = + let e = Cil.constFold false e in + match e with + | BinOp (r, e1, e2, _) -> + begin match two_terms_of_cil false (BinOp (MinusPI, e1, e2, TVoid [])) with + | ((Some t1, Some z1), (Some t2, Some z2)) -> + begin match r with + | Eq -> if negate then [Nequal (t1, t2, Z.(z2-z1))] else [Equal (t1, t2, Z.(z2-z1))] + | Ne -> if negate then [Equal (t1, t2, Z.(z2-z1))] else [Nequal (t1, t2, Z.(z2-z1))] + | _ -> [] + end + | _,_ -> [] + end + | UnOp (Neg, e1, _) -> prop_of_cil e1 (not negate) + | _ -> [] end From aac9fd5889a2f6c50c9b2344fc2a9e6276a63258 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 10 Apr 2024 17:08:51 +0200 Subject: [PATCH 044/323] add test for branching --- tests/regression/79-wrpointer/05-branch.c | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 tests/regression/79-wrpointer/05-branch.c diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/79-wrpointer/05-branch.c new file mode 100644 index 0000000000..21e0b5392c --- /dev/null +++ b/tests/regression/79-wrpointer/05-branch.c @@ -0,0 +1,19 @@ +// PARAM: --set ana.activated[+] wrpointer +#include + +void main(void) { + int *i; + int **j; + int *k; + i = *(j + 3); + *j = k; + j = &k + 1; + int *f; + if (j != &k) { + f = i; + printf("branch1"); + } else { + f = k; + printf("branch2"); + } +} From c4c189fd283cb06dbefd1c9869d6a92383e4a26a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 11 Apr 2024 11:48:29 +0200 Subject: [PATCH 045/323] implemented EvalInt and changed some printing functions --- .../weaklyRelationalPointerAnalysis.ml | 32 +++++++++++++++--- src/cdomains/congruenceClosure.ml | 33 ++++++++++++------- src/cdomains/weaklyRelationalPointerDomain.ml | 21 +++++++----- 3 files changed, 62 insertions(+), 24 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 776a694fd1..7cd0cf65f3 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -37,8 +37,8 @@ struct let prop_list = T.prop_of_cil e neg in let res = meet_conjs_opt st prop_list in if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; neg: %s; prop_list: %s\n" - d_exp e (string_of_bool neg) (show_conj prop_list); + if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; neg: %b; prop_list: %s\n" + d_exp e neg (show_conj prop_list); res let assert_fn ctx e refine = @@ -47,6 +47,19 @@ struct else branch_fn ctx e false + (* Returns true if we know for sure that it is true, and false if we don't know anyhing. *) + let eval_guard t e = + match t with + None -> false + | Some t -> + let prop_list = T.prop_of_cil e false in + let res = match split prop_list with + | [], [] -> false + | x::xs, _ -> fst (eq_query t x) + | _, y::ys -> neq_query t y + in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s\n" + d_exp e (show_conj prop_list); res + end (* module M = Messages @@ -63,11 +76,22 @@ struct let startstate v = D.empty() let exitstate v = D.empty() - let query _ (type a) (q: a Queries.t) = Queries.Result.top q + let query ctx (type a) (q: a Queries.t): a Queries.result = + let open Queries in + match q with + | EvalInt e when eval_guard ctx.local e -> + let ik = Cilfacade.get_ikind_exp e in + ID.of_bool ik true + | EvalInt e when eval_guard ctx.local (UnOp (LNot, e, TInt (Cilfacade.get_ikind_exp e,[]))) -> + let ik = Cilfacade.get_ikind_exp e in + ID.of_bool ik false + (* TODO what is type a + | Queries.Invariant context -> get_normal_form context*) + | _ -> Result.top q let assign ctx var expr = let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in - if M.tracing then M.trace "wrpointer" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res + if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res let branch ctx expr neg = branch_fn ctx expr neg diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index d0ca328649..6821a9f2d3 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -194,8 +194,9 @@ module UnionFind (Val: Val) = struct (** Throws "Unknown value" if v is not present in the data structure. *) let show_uf uf = List.fold_left (fun s eq_class -> s ^ List.fold_left (fun s (v, (refv, size)) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ "; Parent: " ^ Val.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^"\n") "" eq_class - ^ "\n") "" (get_eq_classes uf) ^ "\n" + s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^Val.show v ^ "; P: " ^ Val.show (fst refv) ^ "; o: " ^ Z.to_string (snd refv) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class + ^ "----\n") "" (get_eq_classes uf) ^ "\n" + end @@ -250,7 +251,7 @@ module LookupMap (T: Val) = struct (fun s (r, v) -> s ^ "\t" ^ Z.to_string r ^ ": " ^ List.fold_left (fun s k -> s ^ T.show k ^ ";") - "" (TSet.elements v) ^ "; ") + "" (TSet.elements v) ^ ";; ") "" (zmap_bindings zmap) ^ "\n") "" (bindings map) @@ -396,10 +397,7 @@ module Term(Var:Val) = struct let map_z_opt op z = Tuple2.map2 (Option.map (op z)) let rec two_terms_of_cil neg e = let pos_t, neg_t = match e with - | UnOp (op,exp,typ)-> begin match op with - | Neg -> two_terms_of_cil (not neg) exp - | _ -> of_cil e, (None, Some Z.zero) - end + | UnOp (Neg,exp,typ) -> two_terms_of_cil (not neg) exp | BinOp (binop, exp1, exp2, typ)-> begin match binop with | PlusA | PlusPI @@ -426,7 +424,7 @@ module Term(Var:Val) = struct let e = Cil.constFold false e in match e with | BinOp (r, e1, e2, _) -> - begin match two_terms_of_cil false (BinOp (MinusPI, e1, e2, TVoid [])) with + begin match two_terms_of_cil false (BinOp (MinusPI, e1, e2, TInt (Cilfacade.get_ikind_exp e,[]))) with | ((Some t1, Some z1), (Some t2, Some z2)) -> begin match r with | Eq -> if negate then [Nequal (t1, t2, Z.(z2-z1))] else [Equal (t1, t2, Z.(z2-z1))] @@ -435,7 +433,7 @@ module Term(Var:Val) = struct end | _,_ -> [] end - | UnOp (Neg, e1, _) -> prop_of_cil e1 (not negate) + | UnOp (LNot, e1, _) -> prop_of_cil e1 (not negate) | _ -> [] end @@ -460,7 +458,7 @@ module CongruenceClosure (Var : Val) = struct let empty = TSet.empty let show_set set = TSet.fold (fun v s -> - s ^ "\t" ^ T.show v ^ "\n") set "" ^ "\n" + s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" let rec subterms_of_term (set,map) t = match t with | Addr _ -> (add t set, map) @@ -537,8 +535,8 @@ module CongruenceClosure (Var : Val) = struct let show_min_rep min_representatives = let show_one_rep s (state, (rep, z)) = - s ^ "\tState rep: " ^ T.show state ^ - "\n\tMin. Representative: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")\n\n" + s ^ "\tState: " ^ T.show state ^ + "\n\tMin: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")--\n\n" in List.fold_left show_one_rep "" (bindings min_representatives) @@ -868,6 +866,17 @@ module CongruenceClosure (Var : Val) = struct let (v2,r2),cc = insert cc t2 in (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), cc) + (** + returns true if t1 and t2 are not equivalent + *) + let neq_query cc (t1,t2,r) = + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + if T.compare v1 v2 = 0 then + if r1 = r2 then false + else true + else false + (** Add proposition t1 = t2 + r to the data structure. *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index cc781268fe..ead98a12cd 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -18,12 +18,15 @@ module Disequalities = struct let exp2 = T.to_cil off t2 in let mpt1 = ask.f (MayPointTo exp1) in let mpt2 = ask.f (MayPointTo exp2) in - AD.is_bot (AD.meet mpt1 mpt2) + let res = AD.is_bot (AD.meet mpt1 mpt2) in + if M.tracing then M.tracel "wrpointer" "QUERY MayPointTo. \nt1: %s; res: %a\nt2: %s; res: %a\nresult: %s\n" + (T.show t1) AD.pretty mpt1 (T.show t2) AD.pretty mpt2 (string_of_bool res); res + (**Returns true iff by assigning to t1, the value of t2 doesn't change. *) let rec may_be_equal ask part t1 t2 = match t1, t2 with - | CC.Deref (t, z), CC.Deref (v, z') -> print_string "- "; + | CC.Deref (t, z), CC.Deref (v, z') -> let (q', z1') = TUF.find_no_pc part v in let (q, z1) = TUF.find_no_pc part t in (* If they are in the same equivalence class but with a different offset, then they are not equal *) @@ -34,11 +37,13 @@ module Disequalities = struct not (query_neq ask q q' Z.(z' - z + z1 - z1')) ) || (may_be_equal ask part t1 v) - | CC.Deref _, _ -> print_string "-- ";false (*The value of addresses never change when we overwrite the memory*) - | CC.Addr _ , _ -> print_string "--- ";T.is_subterm t1 t2 + | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) + | CC.Addr _ , _ -> T.is_subterm t1 t2 - let may_be_equal ask part t1 t2 = print_string "may_be_equal "; print_string (T.show t1); print_string " ";print_string (T.show t2); - let res = (may_be_equal ask part t1 t2) in print_string ": "; print_string (string_of_bool res); print_endline "";res + let may_be_equal ask part t1 t2 = + let res = (may_be_equal ask part t1 t2) in + if M.tracing then M.trace "wrpointer" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + res end module D = struct @@ -61,7 +66,7 @@ module D = struct let name () = "wrpointer" - let equal x y = if M.tracing then M.trace "wrpointer" "equal.\nx=\n%s\ny=\n%s" (show_all x) (show_all y); + let equal x y = if M.tracing then M.trace "wrpointer-equal" "equal.\nx=\n%s\ny=\n%s" (show x) (show y); match x, y with | Some x, Some y -> (get_normal_form x = get_normal_form y) @@ -82,7 +87,7 @@ module D = struct let is_top = function None -> false | Some cc -> TUF.is_empty cc.part - let join a b = if M.tracing then M.trace "wrpointer" "JOIN";a + let join a b = if M.tracing then M.trace "wrpointer" "JOIN\n";a let widen = join let meet a b = match a,b with (*TODO put in different file *) From 4d4251963aed4926c6fcf6777b3c9342a5889037 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 11 Apr 2024 11:48:56 +0200 Subject: [PATCH 046/323] modified tests --- tests/regression/79-wrpointer/01-simple.c | 9 +++++++-- tests/regression/79-wrpointer/02-rel-simple.c | 12 ++++++++++++ tests/regression/79-wrpointer/05-branch.c | 4 ++++ 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/tests/regression/79-wrpointer/01-simple.c b/tests/regression/79-wrpointer/01-simple.c index 4a860a535c..ad5537f88c 100644 --- a/tests/regression/79-wrpointer/01-simple.c +++ b/tests/regression/79-wrpointer/01-simple.c @@ -8,6 +8,11 @@ void main(void) { i = *(j + 3); *j = k; - __goblint_check(i == *(j + 3)); - __goblint_check(*j == k); + __goblint_check(**j == *k); + // j was not initialized, so it may by chance point to &i + __goblint_check(i == *(j + 3)); // UNKNOWN! + + j = &k + 1; + + __goblint_check(j == &k); // FAIL } diff --git a/tests/regression/79-wrpointer/02-rel-simple.c b/tests/regression/79-wrpointer/02-rel-simple.c index 84f284f9fb..dbf71de527 100644 --- a/tests/regression/79-wrpointer/02-rel-simple.c +++ b/tests/regression/79-wrpointer/02-rel-simple.c @@ -28,6 +28,10 @@ int main(void) { printf("*k = %d\n", *k); // 3 printf("\n"); + __goblint_check(*j23 == j33); + __goblint_check(*j2 == j3); + __goblint_check(*i == *k); + i = **(j + 3); // j --> *j=j2 --> **j=j3 --> ***j=|4| @@ -40,6 +44,10 @@ int main(void) { printf("*k = %d\n", *k); // 3 printf("\n"); + __goblint_check(*j23 == j33); + __goblint_check(*j2 == j3); + __goblint_check(*i == *j33); + *j = &k; // j2 --> j3 --> |4| @@ -52,6 +60,10 @@ int main(void) { printf("*k = %d\n", *k); // 3 printf("**j2 = %d\n", **j2); // 4 + __goblint_check(*j23 == j33); + __goblint_check(*j2 == j3); + __goblint_check(**j == k); + // not assignable: &k = *j; return 0; diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/79-wrpointer/05-branch.c index 21e0b5392c..90bb7ee47b 100644 --- a/tests/regression/79-wrpointer/05-branch.c +++ b/tests/regression/79-wrpointer/05-branch.c @@ -12,8 +12,12 @@ void main(void) { if (j != &k) { f = i; printf("branch1"); + __goblint_check(0); // NOWARN (unreachable) } else { f = k; printf("branch2"); + __goblint_check(1); // reachable } + + __goblint_check(f == k); } From 604ad9c07ba89d5065a416e0b17f30e4bd543135 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 11 Apr 2024 12:14:17 +0200 Subject: [PATCH 047/323] modified meet_conjs --- src/cdomains/congruenceClosure.ml | 35 ++++++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 4 +-- 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6821a9f2d3..a55c999c0d 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -468,8 +468,7 @@ module CongruenceClosure (Var : Val) = struct subterms_of_term (set, map) t' let subterms_of_prop (set,map) = function - | Equal (t1,t2,_) - | Nequal (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 + | (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list @@ -787,16 +786,14 @@ module CongruenceClosure (Var : Val) = struct (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = let cc = init_cc conj in - let pos, _ = split conj in (* propagating equalities through derefs *) - closure cc pos + closure cc conj (** Returns None if the congruence is unsatisfiable.*) let init_congruence_opt conj = let cc = init_cc conj in - let pos, _ = split conj in (* propagating equalities through derefs *) - match closure cc pos with + match closure cc conj with | exception Unsat -> None | x -> Some x @@ -846,17 +843,6 @@ module CongruenceClosure (Var : Val) = struct let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in {part = part; set = cc.set; map = cc.map; min_repr = min_repr} - (** - Throws "Unsat" if a contradiction is found. - *) - let meet_conjs cc conjs = - let cc = insert_set cc (fst (SSet.subterms_of_conj conjs)) in - closure cc (fst (split conjs)) - - let meet_conjs_opt cc conjs = - match meet_conjs cc conjs with - | exception Unsat -> None - | t -> Some t (** Returns true if t1 and t2 are equivalent. @@ -877,6 +863,21 @@ module CongruenceClosure (Var : Val) = struct else true else false + + (** + Throws "Unsat" if a contradiction is found. + *) + let meet_conjs cc pos_conjs = + let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in + closure cc pos_conjs + + let meet_conjs_opt cc conjs = + let pos_conjs, neg_conjs = split conjs in + if List.exists (fun c-> fst (eq_query cc c)) neg_conjs then None else + match meet_conjs cc pos_conjs with + | exception Unsat -> None + | t -> Some t + (** Add proposition t1 = t2 + r to the data structure. *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index ead98a12cd..0440f433de 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -95,9 +95,7 @@ module D = struct | _, None -> None | Some a, Some b -> let a_conj = get_normal_form a in - match meet_conjs b a_conj with - | res -> Some res - | exception CC.Unsat -> None + meet_conjs_opt b a_conj let leq x y = equal (meet x y) x From fa499266b2d6327bc546a3cdb81c53663840d954 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 11 Apr 2024 14:05:11 +0200 Subject: [PATCH 048/323] fix bug in branch --- src/analyses/weaklyRelationalPointerAnalysis.ml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 7cd0cf65f3..6d84083d47 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -29,7 +29,6 @@ struct (* invertibe assignment *) | _ -> Some t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) - let branch_fn ctx e neg = match ctx.local with | None -> None @@ -57,8 +56,8 @@ struct | [], [] -> false | x::xs, _ -> fst (eq_query t x) | _, y::ys -> neq_query t y - in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s\n" - d_exp e (show_conj prop_list); res + in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %b\n" + d_exp e (show_conj prop_list) res; res end @@ -93,13 +92,12 @@ struct let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res - let branch ctx expr neg = branch_fn ctx expr neg + let branch ctx expr b = branch_fn ctx expr (not b) let body ctx f = ctx.local (*DONE*) let return ctx exp_opt f = ctx.local - let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in match desc.special exprs, v.vname with From 36aef42a89ffe0d3562efcab8ab760afe27633e2 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 11 Apr 2024 14:06:22 +0200 Subject: [PATCH 049/323] update tests --- tests/regression/79-wrpointer/02-rel-simple.c | 30 +++++++++---------- tests/regression/79-wrpointer/05-branch.c | 17 +++++++++-- 2 files changed, 30 insertions(+), 17 deletions(-) diff --git a/tests/regression/79-wrpointer/02-rel-simple.c b/tests/regression/79-wrpointer/02-rel-simple.c index dbf71de527..10050240cd 100644 --- a/tests/regression/79-wrpointer/02-rel-simple.c +++ b/tests/regression/79-wrpointer/02-rel-simple.c @@ -22,11 +22,11 @@ int main(void) { // (j+3) --> j23 --> j33 --> |5| // k=i --> |3| - printf("***j = %d\n", ***j); // 4 - printf("***(j + 3) = %d\n", ***(j + 3)); // 5 - printf("*i = %d\n", *i); // 3 - printf("*k = %d\n", *k); // 3 - printf("\n"); + // printf("***j = %d\n", ***j); // 4 + // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + // printf("*i = %d\n", *i); // 3 + // printf("*k = %d\n", *k); // 3 + // printf("\n"); __goblint_check(*j23 == j33); __goblint_check(*j2 == j3); @@ -38,11 +38,11 @@ int main(void) { // (j+3) --> j23 --> j33=i --> |5| // k --> |3| - printf("***j = %d\n", ***j); // 4 - printf("***(j + 3) = %d\n", ***(j + 3)); // 5 - printf("*i = %d\n", *i); // 5 - printf("*k = %d\n", *k); // 3 - printf("\n"); + // printf("***j = %d\n", ***j); // 4 + // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + // printf("*i = %d\n", *i); // 5 + // printf("*k = %d\n", *k); // 3 + // printf("\n"); __goblint_check(*j23 == j33); __goblint_check(*j2 == j3); @@ -54,11 +54,11 @@ int main(void) { // (j+3) --> j23 --> j33=i --> |5| // j --> *j --> k --> |3| - printf("***j = %d\n", ***j); // 3 - printf("***(j + 3) = %d\n", ***(j + 3)); // 5 - printf("*i = %d\n", *i); // 5 - printf("*k = %d\n", *k); // 3 - printf("**j2 = %d\n", **j2); // 4 + // printf("***j = %d\n", ***j); // 3 + // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + // printf("*i = %d\n", *i); // 5 + // printf("*k = %d\n", *k); // 3 + // printf("**j2 = %d\n", **j2); // 4 __goblint_check(*j23 == j33); __goblint_check(*j2 == j3); diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/79-wrpointer/05-branch.c index 90bb7ee47b..7362bbd3a7 100644 --- a/tests/regression/79-wrpointer/05-branch.c +++ b/tests/regression/79-wrpointer/05-branch.c @@ -10,14 +10,27 @@ void main(void) { j = &k + 1; int *f; if (j != &k) { + f = k; + printf("branch2"); + __goblint_check(1); // reachable + } else { f = i; printf("branch1"); __goblint_check(0); // NOWARN (unreachable) - } else { + } + + __goblint_check(f == k); + + j = &k; + if (j != &k) { f = k; + printf("branch1"); + __goblint_check(0); // NOWARN (unreachable) + } else { + f = i; printf("branch2"); __goblint_check(1); // reachable } - __goblint_check(f == k); + __goblint_check(f == i); } From 40fcd4cb5b66abd76f64dd33eb3610c9b5867baf Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 11 Apr 2024 14:58:53 +0200 Subject: [PATCH 050/323] improve code format --- .../weaklyRelationalPointerAnalysis.ml | 44 ++++++++----------- src/cdomains/congruenceClosure.ml | 9 ++-- src/cdomains/weaklyRelationalPointerDomain.ml | 25 +++++------ 3 files changed, 36 insertions(+), 42 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 6d84083d47..deaa77bd3a 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -2,9 +2,6 @@ (** TODO description *) -(* open Batteries - open GoblintCil - open Pretty *) open Analyses open GoblintCil open WeaklyRelationalPointerDomain @@ -15,15 +12,12 @@ module Operations = struct let assign_lval (t:D.domain) ask lval expr = match t with - | None -> (* The domain is bottom *)None + | None -> None | Some t -> match T.of_lval lval, T.of_cil expr with (* Indefinite assignment *) | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t ask lterm) (* Definite assignment *) - | (Some (Addr x), Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> - (* This is not even possible *) - meet_conjs_opt (insert_set (D.remove_terms_containing_variable t (Addr x)) (SSet.TSet.of_list [Addr x; term])) [Equal (Addr x, term, offset)] | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> meet_conjs_opt (insert_set (D.remove_may_equal_terms t ask lterm) (SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] (* invertibe assignment *) @@ -33,11 +27,11 @@ struct match ctx.local with | None -> None | Some st -> - let prop_list = T.prop_of_cil e neg in - let res = meet_conjs_opt st prop_list in + let props = T.prop_of_cil e neg in + let res = meet_conjs_opt st props in if D.is_bot res then raise Deadcode; if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; neg: %b; prop_list: %s\n" - d_exp e neg (show_conj prop_list); + d_exp e neg (show_conj props); res let assert_fn ctx e refine = @@ -46,23 +40,23 @@ struct else branch_fn ctx e false - (* Returns true if we know for sure that it is true, and false if we don't know anyhing. *) + (* Returns Some true if we know for sure that it is true, + and Some false if we know for sure that it is false, + and None if we don't know anyhing. *) let eval_guard t e = match t with - None -> false + None -> Some false | Some t -> let prop_list = T.prop_of_cil e false in let res = match split prop_list with - | [], [] -> false - | x::xs, _ -> fst (eq_query t x) - | _, y::ys -> neq_query t y - in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %b\n" - d_exp e (show_conj prop_list) res; res + | [], [] -> None + | x::xs, _ -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None + | _, y::ys -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None + in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" + d_exp e (show_conj prop_list) (Option.fold ~none:"None" ~some:string_of_bool res); res end -(* module M = Messages - module VS = SetDomain.Make (CilType.Varinfo) *) module Spec : MCPSpec = struct include DefaultSpec @@ -78,12 +72,12 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in match q with - | EvalInt e when eval_guard ctx.local e -> - let ik = Cilfacade.get_ikind_exp e in - ID.of_bool ik true - | EvalInt e when eval_guard ctx.local (UnOp (LNot, e, TInt (Cilfacade.get_ikind_exp e,[]))) -> - let ik = Cilfacade.get_ikind_exp e in - ID.of_bool ik false + | EvalInt e -> begin match eval_guard ctx.local e with + | None -> Result.top q + | Some res -> + let ik = Cilfacade.get_ikind_exp e in + ID.of_bool ik res + end (* TODO what is type a | Queries.Invariant context -> get_normal_form context*) | _ -> Result.top q diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index a55c999c0d..a9526637e5 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -420,6 +420,9 @@ module Term(Var:Val) = struct | _ -> of_cil e, (None, Some Z.zero) in if neg then neg_t, pos_t else pos_t, neg_t + (** `prop_of_cil e negate` parses the expression `e` (or `not e` if `neg = true`) and + returns a list of length 1 wiith the parsed expresion or an empty list if + the expression can't be expressed with the data type `term`. *) let rec prop_of_cil e negate = let e = Cil.constFold false e in match e with @@ -521,9 +524,9 @@ module CongruenceClosure (Var : Val) = struct (** Minimal representatives map. It maps each representative term of an equivalence class to the minimal term of this representative class. *) module MRMap = struct - module TMap = Map.Make(T) + module TMap = ValMap (T) - type t = (T.t * Z.t) TMap.t [@@deriving eq, ord] + type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings let find = TMap.find @@ -622,7 +625,7 @@ module CongruenceClosure (Var : Val) = struct set: SSet.t; map: LMap.t; min_repr: MRMap.t} - [@@deriving eq, ord] + [@@deriving eq, ord, hash] let show_all x = "Union Find partition:\n" ^ (TUF.show_uf x.part) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 0440f433de..3fc85e0172 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -13,17 +13,16 @@ module Disequalities = struct module AD = AddressDomain.AddressSet (PreValueDomain.Mval) (ValueDomain.ID) (**Find out if two addresses are definitely not equal by using the MayPointTo query*) - let query_neq (ask:Queries.ask) t1 t2 off = + let may_point_to_same_address (ask:Queries.ask) t1 t2 off = let exp1 = T.to_cil Z.zero t1 in let exp2 = T.to_cil off t2 in let mpt1 = ask.f (MayPointTo exp1) in let mpt2 = ask.f (MayPointTo exp2) in - let res = AD.is_bot (AD.meet mpt1 mpt2) in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in if M.tracing then M.tracel "wrpointer" "QUERY MayPointTo. \nt1: %s; res: %a\nt2: %s; res: %a\nresult: %s\n" (T.show t1) AD.pretty mpt1 (T.show t2) AD.pretty mpt2 (string_of_bool res); res - - (**Returns true iff by assigning to t1, the value of t2 doesn't change. *) + (**Returns true iff by assigning to t1, the value of t2 could change. *) let rec may_be_equal ask part t1 t2 = match t1, t2 with | CC.Deref (t, z), CC.Deref (v, z') -> @@ -31,10 +30,10 @@ module Disequalities = struct let (q, z1) = TUF.find_no_pc part t in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( - not (T.equal q' q && not(Z.(equal z (z' + z1 - z1')))) + (not (T.equal q' q) || Z.(equal z (z' + z1 - z1'))) (* or if we know that they are not equal according to the query MayPointTo*) && - not (query_neq ask q q' Z.(z' - z + z1 - z1')) + (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) ) || (may_be_equal ask part t1 v) | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) @@ -50,8 +49,8 @@ module D = struct include Printable.StdLeaf - type domain = t option - type t = domain + type domain = t option [@@deriving ord, hash] + type t = domain [@@deriving ord, hash] (** Convert to string *) let show x = match x with @@ -73,24 +72,20 @@ module D = struct | None, None -> true | _ -> false - let compare x y = 0 (* How to compare if there is no total order? *) - let empty () = Some {part = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty} let init () = init_congruence [] - (** let hash = Hashtbl.hash *) - let hash x = 1 (* TODO *) let bot () = None let is_bot x = x = None let top () = empty () let is_top = function None -> false | Some cc -> TUF.is_empty cc.part - let join a b = if M.tracing then M.trace "wrpointer" "JOIN\n";a + let join a b = if M.tracing then M.trace "wrpointer" "JOIN\n";a (*TODO implement join*) let widen = join - let meet a b = match a,b with (*TODO put in different file *) + let meet a b = match a,b with | None, _ -> None | _, None -> None | Some a, Some b -> @@ -119,6 +114,8 @@ module D = struct let remove_terms_containing_variable cc var = remove_terms cc (T.is_subterm var) + (** Remove terms from the data structure. + It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms cc ask term = let cc = (snd(insert cc term)) in remove_terms cc (Disequalities.may_be_equal ask cc.part term) From 2b39d6f3a366dd0139d4e9e6f18bacb690e5bed9 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 11 Apr 2024 15:06:55 +0200 Subject: [PATCH 051/323] changed negate to pos --- src/analyses/weaklyRelationalPointerAnalysis.ml | 12 ++++++------ src/cdomains/congruenceClosure.ml | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index deaa77bd3a..bea5f4ace6 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -23,15 +23,15 @@ struct (* invertibe assignment *) | _ -> Some t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) - let branch_fn ctx e neg = + let branch_fn ctx e pos = match ctx.local with | None -> None | Some st -> - let props = T.prop_of_cil e neg in + let props = T.prop_of_cil e pos in let res = meet_conjs_opt st props in if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; neg: %b; prop_list: %s\n" - d_exp e neg (show_conj props); + if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; prop_list: %s\n" + d_exp e pos (show_conj props); res let assert_fn ctx e refine = @@ -47,7 +47,7 @@ struct match t with None -> Some false | Some t -> - let prop_list = T.prop_of_cil e false in + let prop_list = T.prop_of_cil e true in let res = match split prop_list with | [], [] -> None | x::xs, _ -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None @@ -86,7 +86,7 @@ struct let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res - let branch ctx expr b = branch_fn ctx expr (not b) + let branch ctx expr b = branch_fn ctx expr b let body ctx f = ctx.local (*DONE*) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index a9526637e5..72683a04dc 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -420,23 +420,23 @@ module Term(Var:Val) = struct | _ -> of_cil e, (None, Some Z.zero) in if neg then neg_t, pos_t else pos_t, neg_t - (** `prop_of_cil e negate` parses the expression `e` (or `not e` if `neg = true`) and - returns a list of length 1 wiith the parsed expresion or an empty list if + (** `prop_of_cil e pos` parses the expression `e` (or `not e` if `pos = false`) and + returns a list of length 1 with the parsed expresion or an empty list if the expression can't be expressed with the data type `term`. *) - let rec prop_of_cil e negate = + let rec prop_of_cil e pos = let e = Cil.constFold false e in match e with | BinOp (r, e1, e2, _) -> begin match two_terms_of_cil false (BinOp (MinusPI, e1, e2, TInt (Cilfacade.get_ikind_exp e,[]))) with | ((Some t1, Some z1), (Some t2, Some z2)) -> begin match r with - | Eq -> if negate then [Nequal (t1, t2, Z.(z2-z1))] else [Equal (t1, t2, Z.(z2-z1))] - | Ne -> if negate then [Equal (t1, t2, Z.(z2-z1))] else [Nequal (t1, t2, Z.(z2-z1))] + | Eq -> if pos then [Equal (t1, t2, Z.(z2-z1))] else [Nequal (t1, t2, Z.(z2-z1))] + | Ne -> if pos then [Nequal (t1, t2, Z.(z2-z1))] else [Equal (t1, t2, Z.(z2-z1))] | _ -> [] end | _,_ -> [] end - | UnOp (LNot, e1, _) -> prop_of_cil e1 (not negate) + | UnOp (LNot, e1, _) -> prop_of_cil e1 (not pos) | _ -> [] end From 2ca1ce7a973dacee6985e3edfea3f737a0a93b04 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 12 Apr 2024 09:32:14 +0200 Subject: [PATCH 052/323] implemented return and combine_env --- .../weaklyRelationalPointerAnalysis.ml | 90 +++++++++++-------- src/cdomains/congruenceClosure.ml | 32 ++++--- src/cdomains/weaklyRelationalPointerDomain.ml | 14 ++- 3 files changed, 85 insertions(+), 51 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index bea5f4ace6..57a8979f21 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -10,35 +10,21 @@ open CC.CongruenceClosure(Var) module Operations = struct + let assign_return t return_var expr = + (* the return value is not stroed on the heap, therefore we don't need to remove any terms *) + match T.of_cil expr with + | (Some term, Some offset) -> meet_conjs_opt (insert_set_opt t (SSet.TSet.of_list [return_var; term])) [Equal (return_var, term, offset)] + | _ -> t + let assign_lval (t:D.domain) ask lval expr = - match t with - | None -> None - | Some t -> - match T.of_lval lval, T.of_cil expr with - (* Indefinite assignment *) - | (Some lterm, Some loffset), (None, _) -> Some (D.remove_may_equal_terms t ask lterm) - (* Definite assignment *) - | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> - meet_conjs_opt (insert_set (D.remove_may_equal_terms t ask lterm) (SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] - (* invertibe assignment *) - | _ -> Some t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) - - let branch_fn ctx e pos = - match ctx.local with - | None -> None - | Some st -> - let props = T.prop_of_cil e pos in - let res = meet_conjs_opt st props in - if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; prop_list: %s\n" - d_exp e pos (show_conj props); - res - - let assert_fn ctx e refine = - if not refine then - ctx.local - else - branch_fn ctx e false + match T.of_lval lval, T.of_cil expr with + (* Indefinite assignment *) + | (Some lterm, Some loffset), (None, _) -> D.remove_may_equal_terms t ask lterm + (* Definite assignment *) + | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> + meet_conjs_opt (insert_set_opt (D.remove_may_equal_terms t ask lterm) (SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] + (* invertibe assignment *) + | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, @@ -57,7 +43,7 @@ struct end -module Spec : MCPSpec = +module Spec = struct include DefaultSpec include Analyses.IdentitySpec @@ -86,29 +72,59 @@ struct let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res - let branch ctx expr b = branch_fn ctx expr b + let branch ctx e pos = + let props = T.prop_of_cil e pos in + let res = meet_conjs_opt ctx.local props in + if D.is_bot res then raise Deadcode; + if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; prop_list: %s\n" + d_exp e pos (show_conj props); + res let body ctx f = ctx.local (*DONE*) - let return ctx exp_opt f = ctx.local + let return_varinfo = dummyFunDec.svar + let return_var = CC.Deref (CC.Addr return_varinfo, Z.zero) + + let return ctx exp_opt f = + let res = match exp_opt with + | Some e -> + assign_return ctx.local return_var e + | None -> ctx.local + in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Lval(Var return_varinfo, NoOffset)) exp_opt) (D.show ctx.local) (D.show res);res let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in match desc.special exprs, v.vname with - | Assert { exp; refine; _ }, _ -> assert_fn ctx exp refine + | Assert { exp; refine; _ }, _ -> if not refine then + ctx.local + else + branch ctx exp true | _, _ -> ctx.local let enter ctx var_opt f args = - let state = ctx.local in let arg_assigns = GobList.combine_short f.sformals args in - let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) state arg_assigns in - if M.tracing then M.trace "wrpointer" "ENTER: result: %s\n" (D.show new_state); + let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) ctx.local arg_assigns in + if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var return_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); [ctx.local, new_state] (*TODO remove callee vars?*) - let combine_env ctx var_opt expr f exprs t_context_opt t ask = t - let combine_assign ctx var_opt expr f exprs t_context_opt t ask = ctx.local + let combine_env ctx var_opt expr f exprs t_context_opt t ask = + let local_vars = f.sformals @ f.slocals in + let res = + D.remove_terms_containing_variables t local_vars + in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var return_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res + + + + let combine_assign ctx var_opt expr f exprs t_context_opt t ask = + let t' = combine_env ctx var_opt expr f exprs t_context_opt t ask in + let t' = match var_opt with + | None -> t' + | Some var -> assign_lval t' ask var (Lval (Var return_varinfo, NoOffset)) + in + let res = D.remove_terms_containing_variable t' (Addr return_varinfo) + in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var return_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res let threadenter ctx ~multiple var_opt v exprs = [ctx.local] let threadspawn ctx ~multiple var_opt v exprs ctx2 = ctx.local diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 72683a04dc..b74758696b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -306,6 +306,10 @@ module Term(Var:Val) = struct | Deref (t, _) -> is_subterm st t | _ -> false + let rec contains_variable variables term = match term with + | Deref (t, _) -> contains_variable variables t + | Addr v -> List.mem v variables + let rec term_depth = function | Addr _ -> 0 | Deref (t, _) -> 1 + term_depth t @@ -840,11 +844,14 @@ module CongruenceClosure (Var : Val) = struct (** Add all terms in a specific set to the data structure. Returns updated (part, set, map, min_repr). *) - let insert_set cc t_set = (* SAFE VERSION but less efficient: SSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) - let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in - (* update min_repr at the end for more efficiency *) - let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in - {part = part; set = cc.set; map = cc.map; min_repr = min_repr} + let insert_set_opt cc t_set = (* SAFE VERSION but less efficient: SSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) + match cc with + | None -> None + | Some cc -> + let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in + (* update min_repr at the end for more efficiency *) + let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in + Some {part = part; set = cc.set; map = cc.map; min_repr = min_repr} (** @@ -855,6 +862,11 @@ module CongruenceClosure (Var : Val) = struct let (v2,r2),cc = insert cc t2 in (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), cc) + let eq_query_opt cc (t1,t2,r) = + match cc with + | None -> false + | Some cc -> fst (eq_query cc (t1,t2,r)) + (** returns true if t1 and t2 are not equivalent *) @@ -871,15 +883,15 @@ module CongruenceClosure (Var : Val) = struct Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = - let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in - closure cc pos_conjs + let cc = insert_set_opt cc (fst (SSet.subterms_of_conj pos_conjs)) in + Option.map (fun cc -> closure cc pos_conjs) cc let meet_conjs_opt cc conjs = let pos_conjs, neg_conjs = split conjs in - if List.exists (fun c-> fst (eq_query cc c)) neg_conjs then None else + if List.exists (fun c-> eq_query_opt cc c) neg_conjs then None else match meet_conjs cc pos_conjs with | exception Unsat -> None - | t -> Some t + | t -> t (** Add proposition t1 = t2 + r to the data structure. @@ -986,7 +998,7 @@ module CongruenceClosure (Var : Val) = struct (** Remove terms from the data structure. It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) - let remove_terms cc predicate = + let remove_terms predicate cc = (* first find all terms that need to be removed *) let new_set, removed_terms_set, map_of_children = SSet.remove_terms (cc.part, cc.set) predicate diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 3fc85e0172..fb6330c6cf 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -88,7 +88,7 @@ module D = struct let meet a b = match a,b with | None, _ -> None | _, None -> None - | Some a, Some b -> + | Some a, b -> let a_conj = get_normal_form a in meet_conjs_opt b a_conj @@ -112,12 +112,18 @@ module D = struct It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable cc var = - remove_terms cc (T.is_subterm var) + Option.map (remove_terms (T.is_subterm var)) cc + + (** Remove terms from the data structure. + It removes all terms which contain one of the "vars", + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variables cc vars = + Option.map (remove_terms (T.contains_variable vars)) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms cc ask term = - let cc = (snd(insert cc term)) in - remove_terms cc (Disequalities.may_be_equal ask cc.part term) + let cc = Option.map (fun cc -> (snd(insert cc term))) cc in + Option.map (fun cc -> remove_terms (Disequalities.may_be_equal ask cc.part term) cc) cc end From 1e7d8880c3c5d70466e011f6ab2e3d1648962540 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 12 Apr 2024 11:43:38 +0200 Subject: [PATCH 053/323] fixed inserting bug --- src/cdomains/congruenceClosure.ml | 160 +++++++++++++++++------------- 1 file changed, 91 insertions(+), 69 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b74758696b..0945f578d3 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -455,7 +455,6 @@ module CongruenceClosure (Var : Val) = struct (** Set of subterms which are present in the current data structure *) module SSet = struct module TSet = ValSet(T) - module TMap = ValMap(T) type t = TSet.t [@@deriving eq, ord, hash] let elements = TSet.elements @@ -463,6 +462,7 @@ module CongruenceClosure (Var : Val) = struct let add = TSet.add let fold = TSet.fold let empty = TSet.empty + let to_list = TSet.to_list let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" @@ -484,45 +484,6 @@ module CongruenceClosure (Var : Val) = struct according to our comparison function. Therefore take_while is enough. *) BatList.take_while (function Addr _ -> true | _ -> false) (elements set) - let add_to_map_of_children value map term = - if T.equal term value then map else - match TMap.find_opt term map with - | None -> TMap.add term [value] map - | Some list -> TMap.add term (value::list) map - - let remove_from_map_of_children parent child map = - match List.remove (TMap.find parent map) child with - | [] -> TMap.remove parent map - | new_children -> TMap.add parent new_children map - - (* remove variables *) - (** Parameters: - - `(part, set)`: union find tree and set of subterms that are present in the union find data structure. - - `predicate`: predicate that returns true for terms which need to be removed from the data structure. - - Returns: - - `new_set`: subset of `set` which contains the terms that do not have to be removed. - - `removed_terms_set`: subset of `set` which contains the terms that have to be removed. - - `map_of_children`: maps each element of union find to its children in the union find tree. It is used in order to later remove these elements from the union find data structure. - *) - let remove_terms (part, set) predicate = - (* Adds `value` to the set that is in the `map` with key `term` *) - let add_to_result el (new_set, removed_terms_set, map_of_children) = - let new_set, removed_terms_set = if predicate el then new_set, add el removed_terms_set else add el new_set, removed_terms_set in - let (uf_parent_ref, _) = TMap.find el part in - let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent_ref) in - (new_set, removed_terms_set, map_of_children) in - TSet.fold add_to_result set (TSet.empty, TSet.empty, TMap.empty) - - let show_map_of_children map_of_children = - List.fold_left - (fun s (v, list) -> - s ^ T.show v ^ "\t:\n" ^ - List.fold_left - (fun s v -> - s ^ T.show v ^ "; ") - "\t" list ^ "\n") - "" (TMap.bindings map_of_children) end (** Minimal representatives map. @@ -631,6 +592,8 @@ module CongruenceClosure (Var : Val) = struct min_repr: MRMap.t} [@@deriving eq, ord, hash] + module TMap = ValMap(T) + let show_all x = "Union Find partition:\n" ^ (TUF.show_uf x.part) ^ "\nSubterm set:\n" @@ -756,13 +719,12 @@ module CongruenceClosure (Var : Val) = struct LMap.remove v1 (LMap.add v zmap map), rest in (* update min_repr *) - let min_v1, min_v2 = LMap.find v1 min_repr, LMap.find v2 min_repr in + let min_v1, min_v2 = MRMap.find v1 min_repr, MRMap.find v2 min_repr in (* 'changed' is true if the new_min is different than the old min *) - let new_min, changed = if fst min_v1 < fst min_v2 then (fst min_v1, not b) else (fst min_v2, b) in - let (_, rep_v, part) = TUF.find part new_min in + let new_min, changed = if fst min_v1 < fst min_v2 then (min_v1, not b) else (min_v2, b) in let removed_v = if b then v2 else v1 in - let min_repr = MRMap.remove removed_v (if changed then MRMap.add v (new_min, rep_v) min_repr else min_repr) in - let queue = if changed then (v :: queue) else queue in + let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in + let queue = v :: queue in closure (part, map, min_repr) queue rest ) @@ -844,7 +806,7 @@ module CongruenceClosure (Var : Val) = struct (** Add all terms in a specific set to the data structure. Returns updated (part, set, map, min_repr). *) - let insert_set_opt cc t_set = (* SAFE VERSION but less efficient: SSet.fold (fun t cc -> snd (insert cc t)) t_set cc*) + let insert_set_opt cc t_set = match cc with | None -> None | Some cc -> @@ -874,7 +836,7 @@ module CongruenceClosure (Var : Val) = struct let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in if T.compare v1 v2 = 0 then - if r1 = r2 then false + if r1 = Z.(r2 + r) then false else true else false @@ -905,24 +867,83 @@ module CongruenceClosure (Var : Val) = struct (* remove variables *) - (** Removes all terms in "removed_terms_set" from the union find data structure. + + + let add_to_map_of_children value map term = + if T.equal term value then map else + match TMap.find_opt term map with + | None -> TMap.add term [value] map + | Some list -> TMap.add term (value::list) map + + let remove_from_map_of_children parent child map = + match List.remove (TMap.find parent map) child with + | [] -> TMap.remove parent map + | new_children -> TMap.add parent new_children map + + let add_successor_terms cc t = + let add_one_successor (cc, successors) (edge_z, _) = + let _, uf_offset, part = TUF.find cc.part t in + let cc = {cc with part = part} in + let successor = Deref (t, Z.(edge_z - uf_offset)) in + let already_present = SSet.mem successor cc.set in + let _, cc, _ = if already_present then (t, Z.zero), cc, [] + else insert_no_min_repr cc successor in + (cc, if already_present then successors else successor::successors) in + List.fold_left add_one_successor (cc, []) (LMap.successors t cc.map) + + (* remove variables *) + (** Parameters: + - `cc`: congruence cloösure data structure + - `predicate`: predicate that returns true for terms which need to be removed from the data structure. + + Returns: + - `new_set`: subset of `set` which contains the terms that do not have to be removed. + - `removed_terms`: list of all elements of `set` which contains the terms that have to be removed. + - `map_of_children`: maps each element of union find to its children in the union find tree. It is used in order to later remove these elements from the union find data structure. + - `cc`: updated congruence closure data structure. + *) + let remove_terms_from_set cc predicate = + let rec remove_terms_recursive (new_set, removed_terms, map_of_children, cc) = function + | [] -> (new_set, removed_terms, map_of_children, cc) + | el::rest -> + (* Adds `value` to the set that is in the `map` with key `term` *) + let new_set, removed_terms = if predicate el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in + let uf_parent = TUF.parent cc.part el in + let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in + let cc, successors = add_successor_terms cc el in + remove_terms_recursive (new_set, removed_terms, map_of_children, cc) (rest @ successors) + in + remove_terms_recursive (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) + + let show_map_of_children map_of_children = + List.fold_left + (fun s (v, list) -> + s ^ T.show v ^ "\t:\n" ^ + List.fold_left + (fun s v -> + s ^ T.show v ^ "; ") + "\t" list ^ "\n") + "" (TMap.bindings map_of_children) + + (** Removes all terms in "removed_terms" from the union find data structure. Returns: - `part`: the updated union find tree - - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. *) - let remove_terms_from_uf part removed_terms_set map_of_children = - let find_not_removed_element set = match List.find (fun el -> not (SSet.mem el removed_terms_set)) set with + - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. + - `map_of_children`: maps each term to its children in the updated union find tree *) + let remove_terms_from_uf part removed_terms map_of_children predicate = + let find_not_removed_element set = match List.find (fun el -> not (predicate el)) set with | exception Not_found -> List.first set | t -> t in - let remove_term t (part, new_parents_map, map_of_children) = + let remove_term (part, new_parents_map, map_of_children) t = match LMap.find_opt t map_of_children with | None -> (* t has no children, so we can safely delete the element from the data structure *) (* we just need to update the size on the whole path from here to the root *) let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (TUF.parent part t) new_parents_map in let parent = fst (TUF.parent part t) in - let map_of_children = if TUF.is_root part t then map_of_children else SSet.remove_from_map_of_children parent t map_of_children in + let map_of_children = if TUF.is_root part t then map_of_children else remove_from_map_of_children parent t map_of_children in (TUF.ValMap.remove t (TUF.change_size t part pred), new_parents_map, map_of_children) | Some children -> let map_of_children = LMap.remove t map_of_children in @@ -939,7 +960,7 @@ module CongruenceClosure (Var : Val) = struct (fun (total_size, map_of_children) child -> (* update parent and offset *) let part = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in - total_size + TUF.subtree_size part child, SSet.add_to_map_of_children child map_of_children new_root + total_size + TUF.subtree_size part child, add_to_map_of_children child map_of_children new_root ) (0, map_of_children) remaining_children in (* Update new root -> set itself as new parent. *) let part = TUF.modify_parent part new_root (new_root, Z.zero) in @@ -954,14 +975,14 @@ module CongruenceClosure (Var : Val) = struct let map_of_children, part = List.fold (fun (map_of_children, part) child -> (* update parent and offset *) - SSet.add_to_map_of_children child map_of_children new_root, + add_to_map_of_children child map_of_children new_root, TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t + new_offset)) ) (map_of_children, part) remaining_children in (* update size of equivalence class *) let part = TUF.change_size new_root part pred in (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) in - Tuple3.get12 @@ SSet.fold remove_term removed_terms_set (part, LMap.empty, map_of_children) + Tuple3.get12 @@ List.fold_left remove_term (part, LMap.empty, map_of_children) removed_terms let show_new_parents_map new_parents_map = List.fold_left (fun s (v1, (v2, o2)) -> @@ -985,32 +1006,33 @@ module CongruenceClosure (Var : Val) = struct (** For all the elements in the removed terms set, it moves the mapped value to the new root. Returns new map and new union-find*) - let remove_terms_from_map (part, map) removed_terms_set new_parents_map = - let remove_from_map term (map, part) = + let remove_terms_from_map (part, map) removed_terms new_parents_map = + let remove_from_map (map, part) term = match LMap.find_opt term map with | None -> map, part | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) match find_new_root new_parents_map part term with | None -> LMap.remove term map, part | Some (new_root, new_offset, part) -> LMap.shift new_root new_offset term map, part - in SSet.fold remove_from_map removed_terms_set (map, part) + in List.fold_left remove_from_map (map, part) removed_terms (** Remove terms from the data structure. It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = (* first find all terms that need to be removed *) - let new_set, removed_terms_set, map_of_children = - SSet.remove_terms (cc.part, cc.set) predicate - in let new_part, new_parents_map = - remove_terms_from_uf cc.part removed_terms_set map_of_children - in let new_map = + let set, removed_terms, map_of_children, cc = + remove_terms_from_set cc predicate + in let part, new_parents_map = + remove_terms_from_uf cc.part removed_terms map_of_children predicate + in let map = remove_terms_from_mapped_values cc.map predicate - in let new_map, new_part = - remove_terms_from_map (new_part, new_map) removed_terms_set new_parents_map - in let min_repr, new_part = MRMap.compute_minimal_representatives (new_part, new_set, new_map) + in let map, part = + remove_terms_from_map (part, map) removed_terms new_parents_map + in if M.tracing then M.trace "wrpointer-remove" "REMOVE TERMS: %s\n RESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + (show_all {part; set; map; min_repr = cc.min_repr}); + let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) in - if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n" (SSet.fold (fun t s -> s ^"; "^T.show t) removed_terms_set ""); - {part = new_part; set = new_set; map = new_map; min_repr = min_repr} + {part; set; map; min_repr} end From 459cb662f0ace620d61cc85902088c6536bd140f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 12 Apr 2024 12:28:19 +0200 Subject: [PATCH 054/323] fixed bug when removing a variable --- src/cdomains/congruenceClosure.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 0945f578d3..c38ba5fc9f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -813,7 +813,7 @@ module CongruenceClosure (Var : Val) = struct let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in - Some {part = part; set = cc.set; map = cc.map; min_repr = min_repr} + Some {part; set = cc.set; map = cc.map; min_repr} (** @@ -930,7 +930,7 @@ module CongruenceClosure (Var : Val) = struct Returns: - `part`: the updated union find tree - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. - - `map_of_children`: maps each term to its children in the updated union find tree *) + *) let remove_terms_from_uf part removed_terms map_of_children predicate = let find_not_removed_element set = match List.find (fun el -> not (predicate el)) set with | exception Not_found -> List.first set @@ -956,12 +956,12 @@ module CongruenceClosure (Var : Val) = struct let remaining_children = List.remove children new_root in let offset_new_root = TUF.parent_offset part new_root in (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) - let new_size, map_of_children = List.fold - (fun (total_size, map_of_children) child -> + let new_size, map_of_children, part = List.fold + (fun (total_size, map_of_children, part) child -> (* update parent and offset *) let part = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in - total_size + TUF.subtree_size part child, add_to_map_of_children child map_of_children new_root - ) (0, map_of_children) remaining_children in + total_size + TUF.subtree_size part child, add_to_map_of_children child map_of_children new_root, part + ) (0, map_of_children, part) remaining_children in (* Update new root -> set itself as new parent. *) let part = TUF.modify_parent part new_root (new_root, Z.zero) in (* update size of equivalence class *) From 3c155d3890745fa078ba2b55c5368c306e8a9754 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Apr 2024 10:21:16 +0200 Subject: [PATCH 055/323] small changes --- src/cdomains/congruenceClosure.ml | 33 +++++++++++-------- src/cdomains/weaklyRelationalPointerDomain.ml | 9 +++-- 2 files changed, 25 insertions(+), 17 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c38ba5fc9f..41410e24d6 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -178,9 +178,9 @@ module UnionFind (Val: Val) = struct if r1 = Z.(r2 + r) then v1, uf, true else raise (Failure "incomparable union") else match ValMap.find_opt v1 uf, ValMap.find_opt v2 uf with - | Some (_,s1), - Some (_,s2) -> - if s1 <= s2 then ( + | Some ((v1, _),s1), + Some ((v2, _),s2) -> + if Val.compare v2 v1 < 0(*s1 <= s2*) then ( v2, change_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false ) else ( v1, change_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true @@ -314,16 +314,22 @@ module Term(Var:Val) = struct | Addr _ -> 0 | Deref (t, _) -> 1 + term_depth t + let rec get_var = function + | Addr v -> v + | Deref (t, _) -> get_var t + let default_int_type = IInt - let rec default_pointer_type n = if n = 0 then TInt (default_int_type, []) else TPtr (default_pointer_type (n-1), []) let to_cil_constant z = Const (CInt (z, default_int_type, Some (Z.to_string z))) let rec to_cil off t = - let cil_t = match t with - | Addr v -> AddrOf (Var v, NoOffset) - | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset) - | Deref (t, z) -> Lval (Mem (to_cil z t), NoOffset) - in if Z.(equal zero off) then cil_t else BinOp (PlusPI, cil_t, to_cil_constant off, default_pointer_type (term_depth t + 1)) + let cil_t, vtyp = match t with + | Addr v -> AddrOf (Var v, NoOffset), TPtr (v.vtype, []) + | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset), v.vtype + | Deref (t, z) -> let cil_t, vtyp = to_cil z t in Lval (Mem cil_t, NoOffset), TPtr (vtyp, []) + in if Z.(equal zero off) then cil_t, vtyp else + BinOp (PlusPI, cil_t, to_cil_constant off, vtyp), vtyp + + let to_cil off t = fst (to_cil off t) (**Returns an integer from a cil expression and None if the expression is not an integer. *) let z_of_exp = function @@ -889,7 +895,7 @@ module CongruenceClosure (Var : Val) = struct let _, cc, _ = if already_present then (t, Z.zero), cc, [] else insert_no_min_repr cc successor in (cc, if already_present then successors else successor::successors) in - List.fold_left add_one_successor (cc, []) (LMap.successors t cc.map) + List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.part t)) cc.map) (* remove variables *) (** Parameters: @@ -1029,10 +1035,9 @@ module CongruenceClosure (Var : Val) = struct remove_terms_from_mapped_values cc.map predicate in let map, part = remove_terms_from_map (part, map) removed_terms new_parents_map - in if M.tracing then M.trace "wrpointer-remove" "REMOVE TERMS: %s\n RESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all {part; set; map; min_repr = cc.min_repr}); - let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) - in + in let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n RESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + (show_all {part; set; map; min_repr = min_repr}); {part; set; map; min_repr} end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index fb6330c6cf..808966fc4a 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -19,8 +19,8 @@ module Disequalities = struct let mpt1 = ask.f (MayPointTo exp1) in let mpt2 = ask.f (MayPointTo exp2) in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer" "QUERY MayPointTo. \nt1: %s; res: %a\nt2: %s; res: %a\nresult: %s\n" - (T.show t1) AD.pretty mpt1 (T.show t2) AD.pretty mpt2 (string_of_bool res); res + if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; res: %a; var1: %d;\nt2: %s; res: %a; var2: %d;\nresult: %s\n" + (T.show t1) AD.pretty mpt1 (T.get_var t1).vid (T.show t2) AD.pretty mpt2 (T.get_var t1).vid (string_of_bool res); res (**Returns true iff by assigning to t1, the value of t2 could change. *) let rec may_be_equal ask part t1 t2 = @@ -41,7 +41,7 @@ module Disequalities = struct let may_be_equal ask part t1 t2 = let res = (may_be_equal ask part t1 t2) in - if M.tracing then M.trace "wrpointer" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + if M.tracing then M.trace "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res end @@ -112,17 +112,20 @@ module D = struct It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable cc var = + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show var); Option.map (remove_terms (T.is_subterm var)) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables cc vars = + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.map (remove_terms (T.contains_variable vars)) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms cc ask term = + if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = Option.map (fun cc -> (snd(insert cc term))) cc in Option.map (fun cc -> remove_terms (Disequalities.may_be_equal ask cc.part term) cc) cc From 7729e3df2eab22450ebd27855b0d70d982aa0bf6 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Apr 2024 10:21:40 +0200 Subject: [PATCH 056/323] small changes --- src/cdomains/congruenceClosure.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 41410e24d6..d2999d8d80 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -178,9 +178,9 @@ module UnionFind (Val: Val) = struct if r1 = Z.(r2 + r) then v1, uf, true else raise (Failure "incomparable union") else match ValMap.find_opt v1 uf, ValMap.find_opt v2 uf with - | Some ((v1, _),s1), - Some ((v2, _),s2) -> - if Val.compare v2 v1 < 0(*s1 <= s2*) then ( + | Some (_,s1), + Some (_,s2) -> + if s1 <= s2 then ( v2, change_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false ) else ( v1, change_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true From df004794d4476bce2abb4045cfb55f1f4e917d06 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Apr 2024 15:15:10 +0200 Subject: [PATCH 057/323] move dummy variabl to the disequalities module --- .../weaklyRelationalPointerAnalysis.ml | 17 ++++++-------- src/cdomains/weaklyRelationalPointerDomain.ml | 22 ++++++++++++------- 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 57a8979f21..47ae18e267 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -82,15 +82,12 @@ struct let body ctx f = ctx.local (*DONE*) - let return_varinfo = dummyFunDec.svar - let return_var = CC.Deref (CC.Addr return_varinfo, Z.zero) - let return ctx exp_opt f = let res = match exp_opt with | Some e -> - assign_return ctx.local return_var e + assign_return ctx.local Disequalities.dummy_var e | None -> ctx.local - in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Lval(Var return_varinfo, NoOffset)) exp_opt) (D.show ctx.local) (D.show res);res + in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Disequalities.dummy_lval) exp_opt) (D.show ctx.local) (D.show res);res let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in @@ -106,14 +103,14 @@ struct GobList.combine_short f.sformals args in let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) ctx.local arg_assigns in - if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var return_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); + if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); [ctx.local, new_state] (*TODO remove callee vars?*) let combine_env ctx var_opt expr f exprs t_context_opt t ask = let local_vars = f.sformals @ f.slocals in let res = D.remove_terms_containing_variables t local_vars - in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var return_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res + in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res @@ -121,10 +118,10 @@ struct let t' = combine_env ctx var_opt expr f exprs t_context_opt t ask in let t' = match var_opt with | None -> t' - | Some var -> assign_lval t' ask var (Lval (Var return_varinfo, NoOffset)) + | Some var -> assign_lval t' ask var Disequalities.dummy_lval in - let res = D.remove_terms_containing_variable t' (Addr return_varinfo) - in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var return_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res + let res = D.remove_terms_containing_variable t' (Addr Disequalities.dummy_varinfo) + in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res let threadenter ctx ~multiple var_opt v exprs = [ctx.local] let threadspawn ctx ~multiple var_opt v exprs ctx2 = ctx.local diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 808966fc4a..fec3f79332 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -12,15 +12,21 @@ module Disequalities = struct module AD = AddressDomain.AddressSet (PreValueDomain.Mval) (ValueDomain.ID) + let dummy_varinfo = dummyFunDec.svar + let dummy_var = CC.Deref (CC.Addr dummy_varinfo, Z.zero) + let dummy_lval = Lval (Var dummy_varinfo, NoOffset) + (**Find out if two addresses are definitely not equal by using the MayPointTo query*) let may_point_to_same_address (ask:Queries.ask) t1 t2 off = - let exp1 = T.to_cil Z.zero t1 in - let exp2 = T.to_cil off t2 in - let mpt1 = ask.f (MayPointTo exp1) in - let mpt2 = ask.f (MayPointTo exp2) in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; res: %a; var1: %d;\nt2: %s; res: %a; var2: %d;\nresult: %s\n" - (T.show t1) AD.pretty mpt1 (T.get_var t1).vid (T.show t2) AD.pretty mpt2 (T.get_var t1).vid (string_of_bool res); res + if t1 = t2 then true else + if Var.equal dummy_varinfo (T.get_var t1) || Var.equal dummy_varinfo (T.get_var t2) then false else + let exp1 = T.to_cil Z.zero t1 in + let exp2 = T.to_cil off t2 in + let mpt1 = ask.f (MayPointTo exp1) in + let mpt2 = ask.f (MayPointTo exp2) in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; res: %a; var1: %d;\nt2: %s; res: %a; var2: %d;\nresult: %s\n" + (T.show t1) AD.pretty mpt1 (T.get_var t1).vid (T.show t2) AD.pretty mpt2 (T.get_var t2).vid (string_of_bool res); res (**Returns true iff by assigning to t1, the value of t2 could change. *) let rec may_be_equal ask part t1 t2 = @@ -106,7 +112,7 @@ module D = struct (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) - | None -> BatPrintf.fprintf f "\n\n\nnormal form\n\n\ntrue\n\n\n" + | None -> BatPrintf.fprintf f "\nbottom\n\n" (** Remove terms from the data structure. It removes all terms for which "var" is a subterm, From ab9e63c9331c6d2e716f24fef38e2ff1e86e1a7b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Apr 2024 15:18:57 +0200 Subject: [PATCH 058/323] modify enter and combine functions --- .../weaklyRelationalPointerAnalysis.ml | 18 ++++++++++++------ src/cdomains/weaklyRelationalPointerDomain.ml | 9 ++++++++- .../regression/79-wrpointer/03-function-call.c | 8 ++++++-- tests/regression/79-wrpointer/05-branch.c | 10 ++++++++++ 4 files changed, 36 insertions(+), 9 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 47ae18e267..58229f7414 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -7,6 +7,7 @@ open GoblintCil open WeaklyRelationalPointerDomain module CC = CongruenceClosure open CC.CongruenceClosure(Var) +open Batteries module Operations = struct @@ -39,7 +40,7 @@ struct | x::xs, _ -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None | _, y::ys -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" - d_exp e (show_conj prop_list) (Option.fold ~none:"None" ~some:string_of_bool res); res + d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res end @@ -70,7 +71,7 @@ struct let assign ctx var expr = let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in - if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.fold ~none:"" ~some:(fun r -> TUF.show_uf r.part) res); res + if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.part) "" res); res let branch ctx e pos = let props = T.prop_of_cil e pos in @@ -99,15 +100,20 @@ struct | _, _ -> ctx.local let enter ctx var_opt f args = - let arg_assigns = - GobList.combine_short f.sformals args - in + (* assign function parameters *) + let arg_assigns = GobList.combine_short f.sformals args in + let arg_vars = List.map fst arg_assigns in let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) ctx.local arg_assigns in + (* remove callee vars *) + let reachable_variables = arg_vars (**@ all globals bzw not_locals*) + in + let new_state = D.remove_terms_not_containing_variables new_state reachable_variables in if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); - [ctx.local, new_state] (*TODO remove callee vars?*) + [ctx.local, new_state] let combine_env ctx var_opt expr f exprs t_context_opt t ask = let local_vars = f.sformals @ f.slocals in + let t = D.meet ctx.local t in let res = D.remove_terms_containing_variables t local_vars in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index fec3f79332..e778c46035 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -16,7 +16,7 @@ module Disequalities = struct let dummy_var = CC.Deref (CC.Addr dummy_varinfo, Z.zero) let dummy_lval = Lval (Var dummy_varinfo, NoOffset) - (**Find out if two addresses are definitely not equal by using the MayPointTo query*) + (**Find out if two addresses are possibly equal by using the MayPointTo query*) let may_point_to_same_address (ask:Queries.ask) t1 t2 off = if t1 = t2 then true else if Var.equal dummy_varinfo (T.get_var t1) || Var.equal dummy_varinfo (T.get_var t2) then false else @@ -128,6 +128,13 @@ module D = struct if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.map (remove_terms (T.contains_variable vars)) cc + (** Remove terms from the data structure. + It removes all terms which do not contain one of the "vars", + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_not_containing_variables cc vars = + if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + Option.map (remove_terms (not % T.contains_variable vars)) cc + (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms cc ask term = diff --git a/tests/regression/79-wrpointer/03-function-call.c b/tests/regression/79-wrpointer/03-function-call.c index ea47d54e21..b89fce9e9c 100644 --- a/tests/regression/79-wrpointer/03-function-call.c +++ b/tests/regression/79-wrpointer/03-function-call.c @@ -1,12 +1,16 @@ // PARAM: --set ana.activated[+] wrpointer #include +#include + +int *i; +int **j; int *f(int **a, int *b) { return *a; } int main(void) { - int *i; - int **j; + j = (int **)malloc(sizeof(int *)); + *j = (int *)malloc(sizeof(int)); int *k = f(j, i); __goblint_check(k == *j); diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/79-wrpointer/05-branch.c index 7362bbd3a7..b3cc4e1988 100644 --- a/tests/regression/79-wrpointer/05-branch.c +++ b/tests/regression/79-wrpointer/05-branch.c @@ -33,4 +33,14 @@ void main(void) { } __goblint_check(f == i); + + if (**j + *k * 23 - 2 * *k == 0 && j != &k) { + f = k; + printf("branch1"); + __goblint_check(0); // NOWARN (unreachable) + } else { + f = i; + printf("branch2"); + __goblint_check(1); // reachable + } } From 0b8d5f42a6008ecbbaa497b443cd3dddb1bb0c84 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Apr 2024 15:31:07 +0200 Subject: [PATCH 059/323] fix bug in combine_env --- src/analyses/weaklyRelationalPointerAnalysis.ml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 58229f7414..d40697de48 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -102,12 +102,8 @@ struct let enter ctx var_opt f args = (* assign function parameters *) let arg_assigns = GobList.combine_short f.sformals args in - let arg_vars = List.map fst arg_assigns in let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) ctx.local arg_assigns in (* remove callee vars *) - let reachable_variables = arg_vars (**@ all globals bzw not_locals*) - in - let new_state = D.remove_terms_not_containing_variables new_state reachable_variables in if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); [ctx.local, new_state] @@ -121,6 +117,7 @@ struct let combine_assign ctx var_opt expr f exprs t_context_opt t ask = + let ask = (ask_of_ctx ctx) in let t' = combine_env ctx var_opt expr f exprs t_context_opt t ask in let t' = match var_opt with | None -> t' From 0154c0ac42149a560f5240388e169dcdbaaa219f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Apr 2024 16:55:05 +0200 Subject: [PATCH 060/323] implemented definite assignments as described in the paper --- src/analyses/weaklyRelationalPointerAnalysis.ml | 15 +++++++++------ src/cdomains/congruenceClosure.ml | 2 +- src/cdomains/weaklyRelationalPointerDomain.ml | 14 +++++++------- tests/regression/79-wrpointer/01-simple.c | 6 ++++-- tests/regression/79-wrpointer/04-remove-vars.c | 3 ++- 5 files changed, 23 insertions(+), 17 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index d40697de48..400b65e026 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -14,16 +14,19 @@ struct let assign_return t return_var expr = (* the return value is not stroed on the heap, therefore we don't need to remove any terms *) match T.of_cil expr with - | (Some term, Some offset) -> meet_conjs_opt (insert_set_opt t (SSet.TSet.of_list [return_var; term])) [Equal (return_var, term, offset)] + | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] (insert_set_opt t (SSet.TSet.of_list [return_var; term])) | _ -> t let assign_lval (t:D.domain) ask lval expr = match T.of_lval lval, T.of_cil expr with (* Indefinite assignment *) - | (Some lterm, Some loffset), (None, _) -> D.remove_may_equal_terms t ask lterm + | (Some lterm, Some loffset), (None, _) -> D.remove_may_equal_terms ask lterm t (* Definite assignment *) | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> - meet_conjs_opt (insert_set_opt (D.remove_may_equal_terms t ask lterm) (SSet.TSet.of_list [lterm; term])) [Equal (lterm, term, offset)] + t |> meet_conjs_opt [Equal (Disequalities.dummy_var, term, offset)] |> + D.remove_may_equal_terms ask lterm |> + meet_conjs_opt [Equal (lterm, Disequalities.dummy_var, Z.zero)] |> + D.remove_terms_containing_variable Disequalities.dummy_var (* invertibe assignment *) | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) @@ -75,7 +78,7 @@ struct let branch ctx e pos = let props = T.prop_of_cil e pos in - let res = meet_conjs_opt ctx.local props in + let res = meet_conjs_opt props ctx.local in if D.is_bot res then raise Deadcode; if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; prop_list: %s\n" d_exp e pos (show_conj props); @@ -111,7 +114,7 @@ struct let local_vars = f.sformals @ f.slocals in let t = D.meet ctx.local t in let res = - D.remove_terms_containing_variables t local_vars + D.remove_terms_containing_variables local_vars t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res @@ -123,7 +126,7 @@ struct | None -> t' | Some var -> assign_lval t' ask var Disequalities.dummy_lval in - let res = D.remove_terms_containing_variable t' (Addr Disequalities.dummy_varinfo) + let res = D.remove_terms_containing_variable Disequalities.dummy_var t' in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res let threadenter ctx ~multiple var_opt v exprs = [ctx.local] diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index d2999d8d80..199644effe 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -854,7 +854,7 @@ module CongruenceClosure (Var : Val) = struct let cc = insert_set_opt cc (fst (SSet.subterms_of_conj pos_conjs)) in Option.map (fun cc -> closure cc pos_conjs) cc - let meet_conjs_opt cc conjs = + let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs = split conjs in if List.exists (fun c-> eq_query_opt cc c) neg_conjs then None else match meet_conjs cc pos_conjs with diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index e778c46035..9ee1c752b5 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -13,8 +13,8 @@ module Disequalities = struct module AD = AddressDomain.AddressSet (PreValueDomain.Mval) (ValueDomain.ID) let dummy_varinfo = dummyFunDec.svar - let dummy_var = CC.Deref (CC.Addr dummy_varinfo, Z.zero) - let dummy_lval = Lval (Var dummy_varinfo, NoOffset) + let dummy_var = CC.Addr dummy_varinfo + let dummy_lval = AddrOf (Var dummy_varinfo, NoOffset) (**Find out if two addresses are possibly equal by using the MayPointTo query*) let may_point_to_same_address (ask:Queries.ask) t1 t2 off = @@ -96,7 +96,7 @@ module D = struct | _, None -> None | Some a, b -> let a_conj = get_normal_form a in - meet_conjs_opt b a_conj + meet_conjs_opt a_conj b let leq x y = equal (meet x y) x @@ -117,27 +117,27 @@ module D = struct (** Remove terms from the data structure. It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variable cc var = + let remove_terms_containing_variable var cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show var); Option.map (remove_terms (T.is_subterm var)) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variables cc vars = + let remove_terms_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.map (remove_terms (T.contains_variable vars)) cc (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) - let remove_terms_not_containing_variables cc vars = + let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.map (remove_terms (not % T.contains_variable vars)) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) - let remove_may_equal_terms cc ask term = + let remove_may_equal_terms ask term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = Option.map (fun cc -> (snd(insert cc term))) cc in Option.map (fun cc -> remove_terms (Disequalities.may_be_equal ask cc.part term) cc) cc diff --git a/tests/regression/79-wrpointer/01-simple.c b/tests/regression/79-wrpointer/01-simple.c index ad5537f88c..605cf3bb18 100644 --- a/tests/regression/79-wrpointer/01-simple.c +++ b/tests/regression/79-wrpointer/01-simple.c @@ -1,16 +1,18 @@ // PARAM: --set ana.activated[+] wrpointer #include +#include void main(void) { int *i; int **j; + j = (int**)malloc(sizeof(int*)+7); + *(j + 3) = (int *)malloc(sizeof(int)); int *k; i = *(j + 3); *j = k; __goblint_check(**j == *k); - // j was not initialized, so it may by chance point to &i - __goblint_check(i == *(j + 3)); // UNKNOWN! + __goblint_check(i == *(j + 3)); j = &k + 1; diff --git a/tests/regression/79-wrpointer/04-remove-vars.c b/tests/regression/79-wrpointer/04-remove-vars.c index d40022f930..b2cb5282df 100644 --- a/tests/regression/79-wrpointer/04-remove-vars.c +++ b/tests/regression/79-wrpointer/04-remove-vars.c @@ -12,7 +12,8 @@ int *f(int **j) { int main(void) { int *i; - int **j; + int **j = (int**)malloc(sizeof(int*)); + *j = (int *)malloc(sizeof(int)); int *k = f(j); __goblint_check(k == *j); From f82765b25987a12ff2de9c86d294f58afd792fa6 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 16 Apr 2024 15:56:47 +0200 Subject: [PATCH 061/323] fixed bug when removing terms --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 199644effe..b5fa800d95 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -965,7 +965,7 @@ module CongruenceClosure (Var : Val) = struct let new_size, map_of_children, part = List.fold (fun (total_size, map_of_children, part) child -> (* update parent and offset *) - let part = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t - offset_new_root)) in + let part = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part child - offset_new_root)) in total_size + TUF.subtree_size part child, add_to_map_of_children child map_of_children new_root, part ) (0, map_of_children, part) remaining_children in (* Update new root -> set itself as new parent. *) From 280e2ef60cd68605840d8483e92e7842bc5cf659 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 16 Apr 2024 15:57:10 +0200 Subject: [PATCH 062/323] added tests for invertible assignments --- .../79-wrpointer/06-invertible-assignment.c | 17 +++++++++++++++++ .../79-wrpointer/07-invertible-assignment2.c | 18 ++++++++++++++++++ .../79-wrpointer/08-simple-assignment.c | 15 +++++++++++++++ 3 files changed, 50 insertions(+) create mode 100644 tests/regression/79-wrpointer/06-invertible-assignment.c create mode 100644 tests/regression/79-wrpointer/07-invertible-assignment2.c create mode 100644 tests/regression/79-wrpointer/08-simple-assignment.c diff --git a/tests/regression/79-wrpointer/06-invertible-assignment.c b/tests/regression/79-wrpointer/06-invertible-assignment.c new file mode 100644 index 0000000000..ba29f3767e --- /dev/null +++ b/tests/regression/79-wrpointer/06-invertible-assignment.c @@ -0,0 +1,17 @@ +// PARAM: --set ana.activated[+] wrpointer +#include + +void main(void) { + int *i; + int **j; + int *k; + j = &k + 1; + j++; + __goblint_check(j == &k + 2); + + i = *(j + 3); + i++; + __goblint_check(i == *(j + 3) + 1); + j++; + __goblint_check(i == *(j + 2) + 1); +} diff --git a/tests/regression/79-wrpointer/07-invertible-assignment2.c b/tests/regression/79-wrpointer/07-invertible-assignment2.c new file mode 100644 index 0000000000..d8d18bd5ac --- /dev/null +++ b/tests/regression/79-wrpointer/07-invertible-assignment2.c @@ -0,0 +1,18 @@ +// PARAM: --set ana.activated[+] wrpointer +// example of the paper "2-Pointer Logic" by Seidl et al., pag. 22 +#include + +void main(void) { + int x; + int *z = &x; + int y = -1 + x; + + __goblint_check(z == &x); + __goblint_check(y == -1 + x); + + *z = 1 + x, + + __goblint_check(&x == z); + __goblint_check(y == -2 + x); + +} diff --git a/tests/regression/79-wrpointer/08-simple-assignment.c b/tests/regression/79-wrpointer/08-simple-assignment.c new file mode 100644 index 0000000000..45d2de90c4 --- /dev/null +++ b/tests/regression/79-wrpointer/08-simple-assignment.c @@ -0,0 +1,15 @@ +// PARAM: --set ana.activated[+] wrpointer +// example of the paper "2-Pointer Logic" by Seidl et al., pag. 21 +#include + +void main(void) { + int x; + int *z = -1 + &x; + + __goblint_check(z == -1 + &x); + + z = (int*) *(1 + z); + + __goblint_check(x == (long)z); + +} From 64f0904cee3b4b2c41f160d9e0b9136d341fb2f6 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 16 Apr 2024 15:57:54 +0200 Subject: [PATCH 063/323] implemented invertible assignments, but I'm not sure that this was even necessary... --- src/cdomains/congruenceClosure.ml | 91 +++++++++++++++++-- src/cdomains/weaklyRelationalPointerDomain.ml | 29 +++++- 2 files changed, 113 insertions(+), 7 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b5fa800d95..e8b8b11e14 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -75,6 +75,10 @@ module UnionFind (Val: Val) = struct let (_, size) = ValMap.find v uf in ValMap.add v ((t, offset), size) uf + let modify_offset uf v modification = + let ((t, offset), size) = ValMap.find v uf in + ValMap.add v ((t, modification offset), size) uf + (** Returns true if each equivalence class in the data structure contains only one element, i.e. every node is a root. *) let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst refv) = 0) (ValMap.bindings uf) @@ -231,13 +235,15 @@ module LookupMap (T: Val) = struct | None -> ZMap.add x y m | Some set -> ZMap.add x (TSet.union y set) m - let map_find_opt (v,r) map = match find_opt v map with + let map_find_opt_set (v,r) map = match find_opt v map with | None -> None | Some zmap -> (match zmap_find_opt r zmap with | None -> None - | Some v -> Some (TSet.any v) + | Some v -> Some v ) + let map_find_opt (v,r) map = Option.map TSet.any (map_find_opt_set (v,r) map) + let map_add (v,r) v' map = let zmap =match find_opt v map with | None -> ZMap.empty | Some zmap ->zmap @@ -284,6 +290,11 @@ module LookupMap (T: Val) = struct (fun _ t_set -> let filtered_set = TSet.filter p t_set in if TSet.is_empty filtered_set then None else Some filtered_set) zmap in if ZMap.is_empty zmap then None else Some zmap) map + + (** Maps elements from the mapped values by applying the function f to them. *) + let map_values map f = + TMap.map (fun zmap -> + ZMap.map (fun t_set -> TSet.map f t_set) zmap) map end exception Unsat @@ -988,7 +999,7 @@ module CongruenceClosure (Var : Val) = struct let part = TUF.change_size new_root part pred in (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) in - Tuple3.get12 @@ List.fold_left remove_term (part, LMap.empty, map_of_children) removed_terms + List.fold_left remove_term (part, LMap.empty, map_of_children) removed_terms let show_new_parents_map new_parents_map = List.fold_left (fun s (v1, (v2, o2)) -> @@ -1026,18 +1037,86 @@ module CongruenceClosure (Var : Val) = struct It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = + let old_cc = cc in + (* first find all terms that need to be removed *) + let set, removed_terms, map_of_children, cc = + remove_terms_from_set cc predicate + in let part, new_parents_map, _ = + remove_terms_from_uf cc.part removed_terms map_of_children predicate + in let map = + remove_terms_from_mapped_values cc.map predicate + in let map, part = + remove_terms_from_map (part, map) removed_terms new_parents_map + in let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) (show_all old_cc) + (show_all {part; set; map; min_repr}); + {part; set; map; min_repr} + + + (* invertible assignments *) + + let shift_uf part map t z off map_of_children = + let t', k1, part = TUF.find part t in + match LMap.map_find_opt_set (t', Z.(z-k1)) map with + | None -> part + | Some to_be_shifted -> + let shift_element el part = + (* modify parent offset *) + let part = if TUF.is_root part el then part else + TUF.modify_offset part el (fun o -> Z.(o - off)) in + (* modify children offset *) + let children = TMap.find el map_of_children in + List.fold_left (fun part child -> TUF.modify_offset part child (Z.(+) off)) part children + in + SSet.fold shift_element to_be_shifted part + + let shift_subterm part map set t z off map_of_children = + let t', k1, part = TUF.find part t in + match LMap.map_find_opt_set (t', Z.(z-k1)) map with + | None -> part, set, map + | Some to_be_shifted -> + let rec modify_subterm v = match v with + | Addr _ -> v + | Deref (v', z) -> let z' = if SSet.mem v' to_be_shifted then Z.(z + off) else z in + Deref (modify_subterm v', z') in + let shift_element el (part, set, map) = + let new_el = modify_subterm el in + (* modify mapping in union find *) + let parent = TUF.ValMap.find el part in + let part = TUF.ValMap.add new_el parent (TUF.ValMap.remove el part) in + (* modify children *) + let children = TMap.find el map_of_children in + let part = List.fold_left (fun part child -> TUF.modify_parent part child (new_el, TUF.parent_offset part child)) part children in + (* modify map *) + let map = match LMap.find_opt el map with + | None -> map + | Some entry -> LMap.add new_el entry (LMap.remove el map) + in (part, SSet.add new_el set, map) + in + let part, set, map = SSet.fold shift_element to_be_shifted (part, set, map) + in part, set, LMap.map_values map modify_subterm + + + (** Remove terms from the data structure. + It removes all terms for which "predicate" is false, + while maintaining all equalities about variables that are not being removed. + Then it shifts all occurences of subterms ∗(z′ + v) where z' + v = z + t + and replaces it with the subterm off+∗(z′+v). *) + let remove_terms_and_shift predicate cc t z off = (* first find all terms that need to be removed *) let set, removed_terms, map_of_children, cc = remove_terms_from_set cc predicate - in let part, new_parents_map = + in let part, new_parents_map, map_of_children = remove_terms_from_uf cc.part removed_terms map_of_children predicate in let map = remove_terms_from_mapped_values cc.map predicate in let map, part = remove_terms_from_map (part, map) removed_terms new_parents_map + in let part = shift_uf part cc.map t z off map_of_children + in let part,set,map = shift_subterm part cc.map set t z off map_of_children in let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n RESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all {part; set; map; min_repr = min_repr}); + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS AND SHIFT: %s\n RESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + (show_all {part; set; map; min_repr}); {part; set; map; min_repr} end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 9ee1c752b5..17b0290031 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -47,8 +47,26 @@ module Disequalities = struct let may_be_equal ask part t1 t2 = let res = (may_be_equal ask part t1 t2) in - if M.tracing then M.trace "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res + + (**Returns true iff by assigning to t1, the value of t2 could change. + But if we know that t1 and t2 are definitely equal, then it returns false. *) + let rec may_be_equal_but_not_definitely_equal ask part t1 t2 = + match t1, t2 with + | CC.Deref (t, z), CC.Deref (v, z') -> + let (q', z1') = TUF.find_no_pc part v in + let (q, z1) = TUF.find_no_pc part t in + (* If they are in the same equivalence class, then we return false *) + ( + (not (T.equal q' q)) + (* or if we know that they are not equal according to the query MayPointTo*) + && + (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) + ) + || (may_be_equal ask part t1 v) + | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) + | CC.Addr _ , _ -> T.is_subterm t1 t2 end module D = struct @@ -142,4 +160,13 @@ module D = struct let cc = Option.map (fun cc -> (snd(insert cc term))) cc in Option.map (fun cc -> remove_terms (Disequalities.may_be_equal ask cc.part term) cc) cc + (** Remove terms from the data structure and shifts other terms. + It removes all terms that may be changed after an assignment to "term". + It shifts all elements that were modified by the asignmnt to "term". *) + let remove_and_shift_may_equal_terms ask cc t z off = + let term = CC.Deref (t, z) in + if M.tracing then M.trace "wrpointer" "remove_and_shift_may_equal_terms: %s. Off: %s\n" (T.show term) (Z.to_string off); + let cc = Option.map (fun cc -> (snd(insert cc term))) cc in + Option.map (fun cc -> remove_terms_and_shift (Disequalities.may_be_equal_but_not_definitely_equal ask cc.part term) cc t z off) cc + end From 491d636f76c4291d75c3b51a1503146274422b47 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Apr 2024 15:02:25 +0200 Subject: [PATCH 064/323] fix bug when removing variables --- src/cdomains/congruenceClosure.ml | 20 ++++++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 18 ++++++++--------- 2 files changed, 20 insertions(+), 18 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index e8b8b11e14..8151fd7ff0 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -362,8 +362,8 @@ module Term(Var:Val) = struct | Const c -> None, z_of_exp (Const c) | Lval lval -> of_lval lval | AlignOf _ - | AlignOfE _ - | StartOf _ -> (*no idea*) None, None + | AlignOfE _ -> (*no idea*) None, None + | StartOf lval -> of_lval lval | AddrOf (Var var, NoOffset) -> Some (Addr var), Some Z.zero | AddrOf (Mem exp, NoOffset) -> of_cil exp | UnOp (op,exp,typ)-> begin match op with @@ -395,10 +395,12 @@ module Term(Var:Val) = struct | AddrOf lval -> (*TODO*)None, None | _ -> None, None and of_lval = function - | (Var var, offset) -> begin match of_offset offset with - | None -> None, None - | Some off -> Some (Deref (Addr var, Z.zero)), Some off + | (Var var, NoOffset) -> Some (Deref (Addr var, Z.zero)), Some Z.zero + | (Var var, Index (exp, NoOffset)) -> begin match of_cil exp with + | None, Some off -> Some (Deref ((Deref (Addr var, Z.zero)), off)), Some Z.zero + | _ -> None, None end + | (Var var, _) -> None, None (*TODO: Index with Offset, and Field*) | (Mem exp, offset) -> begin match of_cil exp, of_offset offset with | (Some term, Some offset), Some z_offset -> Some (Deref (term, offset)), Some z_offset @@ -924,7 +926,7 @@ module CongruenceClosure (Var : Val) = struct | [] -> (new_set, removed_terms, map_of_children, cc) | el::rest -> (* Adds `value` to the set that is in the `map` with key `term` *) - let new_set, removed_terms = if predicate el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in + let new_set, removed_terms = if predicate cc.part el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in let uf_parent = TUF.parent cc.part el in let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in let cc, successors = add_successor_terms cc el in @@ -949,7 +951,7 @@ module CongruenceClosure (Var : Val) = struct - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. *) let remove_terms_from_uf part removed_terms map_of_children predicate = - let find_not_removed_element set = match List.find (fun el -> not (predicate el)) set with + let find_not_removed_element set = match List.find (fun el -> not (predicate part el)) set with | exception Not_found -> List.first set | t -> t in @@ -1044,7 +1046,7 @@ module CongruenceClosure (Var : Val) = struct in let part, new_parents_map, _ = remove_terms_from_uf cc.part removed_terms map_of_children predicate in let map = - remove_terms_from_mapped_values cc.map predicate + remove_terms_from_mapped_values cc.map (predicate cc.part) in let map, part = remove_terms_from_map (part, map) removed_terms new_parents_map in let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) @@ -1109,7 +1111,7 @@ module CongruenceClosure (Var : Val) = struct in let part, new_parents_map, map_of_children = remove_terms_from_uf cc.part removed_terms map_of_children predicate in let map = - remove_terms_from_mapped_values cc.map predicate + remove_terms_from_mapped_values cc.map (predicate cc.part) in let map, part = remove_terms_from_map (part, map) removed_terms new_parents_map in let part = shift_uf part cc.map t z off map_of_children diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 17b0290031..c48736bb93 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -137,36 +137,36 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show var); - Option.map (remove_terms (T.is_subterm var)) cc + Option.map (remove_terms (fun _ -> T.is_subterm var)) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.map (remove_terms (T.contains_variable vars)) cc + Option.map (remove_terms (fun _ -> T.contains_variable vars)) cc (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.map (remove_terms (not % T.contains_variable vars)) cc + Option.map (remove_terms (fun _ -> not % T.contains_variable vars)) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = Option.map (fun cc -> (snd(insert cc term))) cc in - Option.map (fun cc -> remove_terms (Disequalities.may_be_equal ask cc.part term) cc) cc + Option.map (remove_terms (fun part -> Disequalities.may_be_equal ask part term)) cc (** Remove terms from the data structure and shifts other terms. It removes all terms that may be changed after an assignment to "term". It shifts all elements that were modified by the asignmnt to "term". *) - let remove_and_shift_may_equal_terms ask cc t z off = - let term = CC.Deref (t, z) in - if M.tracing then M.trace "wrpointer" "remove_and_shift_may_equal_terms: %s. Off: %s\n" (T.show term) (Z.to_string off); - let cc = Option.map (fun cc -> (snd(insert cc term))) cc in - Option.map (fun cc -> remove_terms_and_shift (Disequalities.may_be_equal_but_not_definitely_equal ask cc.part term) cc t z off) cc + let remove_and_shift_may_equal_terms ask cc t z off = + let term = CC.Deref (t, z) in + if M.tracing then M.trace "wrpointer" "remove_and_shift_may_equal_terms: %s. Off: %s\n" (T.show term) (Z.to_string off); + let cc = Option.map (fun cc -> (snd(insert cc term))) cc in + Option.map (fun cc -> remove_terms_and_shift (fun part -> Disequalities.may_be_equal_but_not_definitely_equal ask part term) cc t z off) cc end From 0742feaa04c69161af97cd495ce9f99f22454b07 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Apr 2024 15:02:46 +0200 Subject: [PATCH 065/323] add a few tests --- .../79-wrpointer/09-different-offsets.c | 20 +++++++++++ .../79-wrpointer/10-different-types.c | 35 ++++++++++++++++++ tests/regression/79-wrpointer/11-array.c | 36 +++++++++++++++++++ .../regression/79-wrpointer/12-rel-function.c | 22 ++++++++++++ 4 files changed, 113 insertions(+) create mode 100644 tests/regression/79-wrpointer/09-different-offsets.c create mode 100644 tests/regression/79-wrpointer/10-different-types.c create mode 100644 tests/regression/79-wrpointer/11-array.c create mode 100644 tests/regression/79-wrpointer/12-rel-function.c diff --git a/tests/regression/79-wrpointer/09-different-offsets.c b/tests/regression/79-wrpointer/09-different-offsets.c new file mode 100644 index 0000000000..7025a5f7d7 --- /dev/null +++ b/tests/regression/79-wrpointer/09-different-offsets.c @@ -0,0 +1,20 @@ +// PARAM: --set ana.activated[+] wrpointer +#include +#include + +struct Pair { + int *first; + int *second; +}; + +void main(void) { + int *x; + struct Pair p; + p.first = x; + + struct Pair p2; + p2.first = x; + + __goblint_check(p.first == p2.first); + +} diff --git a/tests/regression/79-wrpointer/10-different-types.c b/tests/regression/79-wrpointer/10-different-types.c new file mode 100644 index 0000000000..8638f1215b --- /dev/null +++ b/tests/regression/79-wrpointer/10-different-types.c @@ -0,0 +1,35 @@ +// PARAM: --set ana.activated[+] wrpointer +#include +#include + +void main(void) { + // no problem if they are all ints + int *ipt = (int *)malloc(sizeof(long)); + int *ipt2; + int i; + *ipt = i; + // *ipt: 0; i: 0 + __goblint_check(*ipt == i); + ipt2 = (int *)ipt; + *(ipt2 + 1) = 'a'; + // *ipt: 0; i: 0 + __goblint_check(*ipt == i); + + // long pointer is cast to char pointer -> *(cpt + 1) overwrites *lpt + long *lpt = (long *)malloc(sizeof(long)); + char *cpt; + long l; + *lpt = l; + // *lpt: 0; l: 0 + __goblint_check(*lpt == l); + cpt = (char *)lpt; + *(cpt + 1) = 'a'; + + // *lpt: 24832; l: 0 + __goblint_check(*lpt == l); // UNKNOWN! + *lpt = l; + // *lpt: 0; l: 0 + __goblint_check(*lpt == l); + // *lpt: 24832; l: 0 + __goblint_check(*lpt == l); // UNKNOWN! +} diff --git a/tests/regression/79-wrpointer/11-array.c b/tests/regression/79-wrpointer/11-array.c new file mode 100644 index 0000000000..222239cfe0 --- /dev/null +++ b/tests/regression/79-wrpointer/11-array.c @@ -0,0 +1,36 @@ +// PARAM: --set ana.activated[+] wrpointer +#include +#include + +void main(void) { + int i[6][5]; + int m[5]; + + i[3][1] = m[2]; + + __goblint_check(i[3][1] == m[2]); + + int i2[6]; + int m2[5]; + + i2[3] = m2[2]; + + __goblint_check(i2[3] == m2[2]); + +// int **j; +// int *l; +// j = (int **)malloc(sizeof(int *) + 7); +// j[3] = (int *)malloc(sizeof(int)); +// int *k; +// l = j[3]; +// j[0] = k; +// j[2] = m; + +// __goblint_check(**j == *k); +// __goblint_check(l == *(j + 3)); +// __goblint_check(j[2] == m); + +// j = &k + 1; + +// __goblint_check(j == &k); // FAIL +} diff --git a/tests/regression/79-wrpointer/12-rel-function.c b/tests/regression/79-wrpointer/12-rel-function.c new file mode 100644 index 0000000000..639c6612df --- /dev/null +++ b/tests/regression/79-wrpointer/12-rel-function.c @@ -0,0 +1,22 @@ +// PARAM: --set ana.activated[+] wrpointer + +#include +#include + +void *f(int **a, int **b) { + int *j; + int **i = &j; + j = (int *)malloc(sizeof(int) * 2); + *a = j; + *b = *i + 1; +} + +int main(void) { + int **c = (int**)malloc(sizeof(int*)); + int **d = (int**)malloc(sizeof(int*));; + f(c, d); + + __goblint_check(*d == *c + 1); + + return 0; +} From 1f076a6cc8ad9ea7dbb1be4ef9186ca382fb90f0 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Apr 2024 15:38:37 +0200 Subject: [PATCH 066/323] implemented hash functions --- src/cdomains/congruenceClosure.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 8151fd7ff0..37e9772813 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -14,12 +14,12 @@ end module ValMap(Val:Val) = struct include Map.Make(Val) - let hash x y = 3 + let hash node_hash y = fold (fun x node acc -> acc + Val.hash x + node_hash node) y 0 end module ValSet(Val:Val) = struct include Set.Make(Val) - let hash x = 3 + let hash x = fold (fun x y -> y + Val.hash x) x 0 end (** Quantitative union find *) @@ -211,7 +211,7 @@ module LookupMap (T: Val) = struct module ZMap = struct include Map.Make(Z) - let hash x y = 3 + let hash node_hash y = fold (fun x node acc -> acc + Z.hash x + node_hash node) y 0 end type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] From c41721859b00c7cbe8f794bb0176e439c7b58059 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Apr 2024 17:17:56 +0200 Subject: [PATCH 067/323] add some comments --- .../weaklyRelationalPointerAnalysis.ml | 72 ++- src/cdomains/congruenceClosure.ml | 534 +++++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 30 +- 3 files changed, 306 insertions(+), 330 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 400b65e026..411b6cb561 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -9,26 +9,16 @@ module CC = CongruenceClosure open CC.CongruenceClosure(Var) open Batteries -module Operations = +module Spec = struct - let assign_return t return_var expr = - (* the return value is not stroed on the heap, therefore we don't need to remove any terms *) - match T.of_cil expr with - | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] (insert_set_opt t (SSet.TSet.of_list [return_var; term])) - | _ -> t + include DefaultSpec + include Analyses.IdentitySpec + module D = D + module C = D - let assign_lval (t:D.domain) ask lval expr = - match T.of_lval lval, T.of_cil expr with - (* Indefinite assignment *) - | (Some lterm, Some loffset), (None, _) -> D.remove_may_equal_terms ask lterm t - (* Definite assignment *) - | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> - t |> meet_conjs_opt [Equal (Disequalities.dummy_var, term, offset)] |> - D.remove_may_equal_terms ask lterm |> - meet_conjs_opt [Equal (lterm, Disequalities.dummy_var, Z.zero)] |> - D.remove_terms_containing_variable Disequalities.dummy_var - (* invertibe assignment *) - | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) + let name () = "wrpointer" + let startstate v = D.empty() + let exitstate v = D.empty() (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, @@ -45,20 +35,6 @@ struct in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res -end - -module Spec = -struct - include DefaultSpec - include Analyses.IdentitySpec - include Operations - module D = D - module C = D - - let name () = "wrpointer" - let startstate v = D.empty() - let exitstate v = D.empty() - let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in match q with @@ -72,9 +48,23 @@ struct | Queries.Invariant context -> get_normal_form context*) | _ -> Result.top q - let assign ctx var expr = - let res = assign_lval ctx.local (ask_of_ctx ctx) var expr in - if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval var d_exp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.part) "" res); res + let assign_lval t ask lval expr = + match T.of_lval lval, T.of_cil expr with + (* Indefinite assignment *) + | (Some lterm, Some loffset), (None, _) -> D.remove_may_equal_terms ask lterm t + (* Definite assignment *) + | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> + if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s + %s; expr: %s + %s\n" (T.show lterm) (Z.to_string loffset) (T.show term) (Z.to_string offset); + t |> meet_conjs_opt [Equal (Disequalities.dummy_var, term, offset)] |> + D.remove_may_equal_terms ask lterm |> + meet_conjs_opt [Equal (lterm, Disequalities.dummy_var, Z.zero)] |> + D.remove_terms_containing_variable Disequalities.dummy_var + (* invertibe assignment *) + | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) + + let assign ctx lval expr = + let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in + if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_exp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res let branch ctx e pos = let props = T.prop_of_cil e pos in @@ -86,6 +76,12 @@ struct let body ctx f = ctx.local (*DONE*) + let assign_return t return_var expr = + (* the return value is not stored on the heap, therefore we don't need to remove any terms *) + match T.of_cil expr with + | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] (insert_set_opt t (SSet.TSet.of_list [return_var; term])) + | _ -> t + let return ctx exp_opt f = let res = match exp_opt with | Some e -> @@ -107,6 +103,10 @@ struct let arg_assigns = GobList.combine_short f.sformals args in let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) ctx.local arg_assigns in (* remove callee vars *) + let arg_vars = List.map fst arg_assigns in + let reachable_variables = arg_vars (**@ all globals bzw not_locals*) + in + let new_state = D.remove_terms_not_containing_variables reachable_variables new_state in if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); [ctx.local, new_state] @@ -117,8 +117,6 @@ struct D.remove_terms_containing_variables local_vars t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res - - let combine_assign ctx var_opt expr f exprs t_context_opt t ask = let ask = (ask_of_ctx ctx) in let t' = combine_env ctx var_opt expr f exprs t_context_opt t ask in diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 37e9772813..f289cce702 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -29,8 +29,6 @@ module UnionFind (Val: Val) = struct (** (value * offset) ref * size of equivalence class *) type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] - (** Maps each value to its children in the union find data structure. - Necessary in order to be able to delete values. *) type t = Val.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) exception UnknownValue of Val.t @@ -38,38 +36,35 @@ module UnionFind (Val: Val) = struct let empty = ValMap.empty - (** create empty union find map *) - let init : Val.t list -> t = - List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) + (** create empty union find map, given a list of elements *) + let init = List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) (** `parent uf v` returns (p, z) where p is the parent element of - v in the union find tree and z is the offset. *) - let parent uf v = - let (refv, _) = ValMap.find v uf in - refv + v in the union find tree and z is the offset. + + Throws "Unknown value" if v is not present in the data structure.*) + let parent uf v = match fst (ValMap.find v uf) with + | exception Not_found -> raise (UnknownValue v) + | x -> x (** `parent_opt uf v` returns Some (p, z) where p is the parent element of v in the union find tree and z is the offset. It returns None if v is not present in the data structure. *) - let parent_opt uf v = - match ValMap.find_opt v uf with - | None -> None - | Some _ -> Some (parent uf v) - - let parent_offset uf v = - snd (parent uf v) + let parent_opt uf v = Option.map (fun _ -> parent uf v) (ValMap.find_opt v uf) + let parent_term uf v = fst (parent uf v) + let parent_offset uf v = snd (parent uf v) let subtree_size uf v = snd (ValMap.find v uf) (** Modifies the size of the equivalence class for the current element and for the whole path to the root of this element. The third parameter `modification` is the function to apply to the sizes. *) - let rec change_size t part modification = - let (ref_r, old_size) = ValMap.find t part in - let part = ValMap.add t (ref_r, modification old_size) part in - let parent = fst(ref_r) in - if parent = t then part else change_size parent part modification + let rec modify_size t uf modification = + let (p, old_size) = ValMap.find t uf in + let uf = ValMap.add t (p, modification old_size) uf in + let parent = fst p in + if parent = t then uf else modify_size parent uf modification let modify_parent uf v (t, offset) = let (_, size) = ValMap.find v uf in @@ -81,14 +76,12 @@ module UnionFind (Val: Val) = struct (** Returns true if each equivalence class in the data structure contains only one element, i.e. every node is a root. *) - let is_empty uf = List.for_all (fun (v, (refv, _)) -> Val.compare v (fst refv) = 0) (ValMap.bindings uf) + let is_empty uf = List.for_all (fun (v, (t, _)) -> Val.equal v (fst t)) (ValMap.bindings uf) - (** Returns true if v is the representative value of its equivalence class + (** Returns true if v is the representative value of its equivalence class. Throws "Unknown value" if v is not present in the data structure. *) - let is_root uf v = match parent_opt uf v with - | None -> raise (UnknownValue v) - | Some (parent_t, _) -> Val.compare v parent_t = 0 + let is_root uf v = let (parent_t, _) = parent uf v in Val.equal v parent_t (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements grouped by equivalence classes, while this function just prints them in any order. @@ -106,55 +99,52 @@ module UnionFind (Val: Val) = struct It returns als the updated union-find tree after the path compression. Throws "Unknown value" if t is not present in the data structure. - Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. *) let find uf v = - match ValMap.find_opt v uf with - | None -> raise (UnknownValue v) - | Some (refv,_) -> let (v',r') = refv in - if Val.compare v' v = 0 then - if Z.equal r' Z.zero then v',r', uf - else raise (InvalidUnionFind "non-zero self-distance!") - else if is_root uf v' then - v',r', uf - else - let rec search v list = match ValMap.find_opt v uf with - | None -> raise (UnknownValue v) - | Some (refv,_) -> let (v',r') = refv in - if is_root uf v' then - let (_,uf) = List.fold_left (fun (r0,part) v -> - let (parent_v, r'') = parent part v in - let size_v = subtree_size part v in - let part = modify_parent part v (v',Z.(r0+r'')) in - let part = change_size parent_v part (fun s -> s - size_v) in - let part = change_size v' part ((+) size_v) - in Z.(r0+r''),part) (Z.zero,uf) (v::list) - in v',r',uf - else search v' (v :: list) - in search v' [v] + let (v',r') = parent uf v in + if Val.equal v' v then + (* v is a root *) + if Z.equal r' Z.zero then v',r', uf + else raise (InvalidUnionFind "non-zero self-distance!") + else if is_root uf v' then + (* the parent of v is a root *) + v',r', uf + else + let rec search v list = + let (v',r') = parent uf v in + if is_root uf v' then + (* perform path compresion *) + let (_,uf) = List.fold_left (fun (r0, uf) v -> + let (parent_v, r''), size_v = ValMap.find v uf in + let uf = modify_parent uf v (v',Z.(r0+r'')) in + let uf = modify_size parent_v uf (fun s -> s - size_v) in + let uf = modify_size v' uf ((+) size_v) + in Z.(r0+r''),uf) (Z.zero, uf) (v::list) + in v',r',uf + else search v' (v :: list) + in search v' [v] (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) let find_opt uf v = match find uf v with | exception (UnknownValue _) + | exception Not_found | exception (InvalidUnionFind _) -> None | res -> Some res - (** For a variable t it returns the reference variable v and the offset r. This find DOES NOT perform path compression. Throws "Unknown value" if t is not present in the data structure. - Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. *) let rec find_no_pc uf v = - match ValMap.find_opt v uf with - | None -> raise (UnknownValue v) - | Some ((v',r'),_) -> - if Val.compare v' v = 0 then - if Z.equal r' Z.zero then (v',r') - else raise (InvalidUnionFind "non-zero self-distance!") - else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) + let (v',r') = parent uf v in + if Val.compare v' v = 0 then + if Z.equal r' Z.zero then (v',r') + else raise (InvalidUnionFind "non-zero self-distance!") + else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare @@ -163,55 +153,53 @@ module UnionFind (Val: Val) = struct let compare_repr_v (v1, _) (v2, _) = Val.compare v1 v2 (** - Parameters: part v1 v2 r + Parameters: uf v1 v2 r - chages the union find data structure `part` such that the equivalence classes of `v1` and `v2` are merged and `v1 = v2 + r` + changes the union find data structure `uf` such that the equivalence classes of `v1` and `v2` are merged and `v1 = v2 + r` - returns v,part,b where + returns v,uf,b where - `v` is the new reference variable of the merged equivalence class. It is either the old reference variable of v1 or of v2, depending on which equivalence class is bigger. - - `part` is the new union find data structure + - `uf` is the new union find data structure - `b` is true iff v = find v1 *) - let union uf v'1 v'2 r = let v1,r1,uf = find uf v'1 in + let union uf v'1 v'2 r = + let v1,r1,uf = find uf v'1 in let v2,r2,uf = find uf v'2 in - if Val.compare v1 v2 = 0 then + if Val.equal v1 v2 then if r1 = Z.(r2 + r) then v1, uf, true else raise (Failure "incomparable union") - else match ValMap.find_opt v1 uf, ValMap.find_opt v2 uf with - | Some (_,s1), - Some (_,s2) -> - if s1 <= s2 then ( - v2, change_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false - ) else ( - v1, change_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true - ) - | None, _ -> raise (UnknownValue v1) - | _, _ -> raise (UnknownValue v2) + else let (_,s1), (_,s2) = ValMap.find v1 uf, ValMap.find v2 uf in + if s1 <= s2 then ( + v2, modify_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false + ) else ( + v1, modify_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true + ) (** Returns a list of equivalence classes. *) let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) - (** Throws "Unknown value" if v is not present in the data structure. *) + (** Throws "Unknown value" if the data structure is invalid. *) let show_uf uf = List.fold_left (fun s eq_class -> - s ^ List.fold_left (fun s (v, (refv, size)) -> - s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^Val.show v ^ "; P: " ^ Val.show (fst refv) ^ "; o: " ^ Z.to_string (snd refv) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class + s ^ List.fold_left (fun s (v, (t, size)) -> + s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^Val.show v ^ "; P: " ^ Val.show (fst t) ^ + "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class ^ "----\n") "" (get_eq_classes uf) ^ "\n" - - end +(** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a set containing + all terms in the data structure that are equal to *(z + t').*) module LookupMap (T: Val) = struct module TMap = ValMap(T) module TSet = ValSet(T) module ZMap = struct include Map.Make(Z) - let hash node_hash y = fold (fun x node acc -> acc + Z.hash x + node_hash node) y 0 + let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 end type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] @@ -226,15 +214,15 @@ module LookupMap (T: Val) = struct let zmap_bindings = ZMap.bindings (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). *) let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) - let zmap_find_opt = ZMap.find_opt - let set_any = TSet.any + (** Merges the set "m" with the set that is already present in the data structure. *) let zmap_add x y m = match zmap_find_opt x m with | None -> ZMap.add x y m | Some set -> ZMap.add x (TSet.union y set) m + (** Returns the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) let map_find_opt_set (v,r) map = match find_opt v map with | None -> None | Some zmap -> (match zmap_find_opt r zmap with @@ -242,9 +230,11 @@ module LookupMap (T: Val) = struct | Some v -> Some v ) + (** Returns one element of the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) let map_find_opt (v,r) map = Option.map TSet.any (map_find_opt_set (v,r) map) - let map_add (v,r) v' map = let zmap =match find_opt v map with + (** Adds the term "v'" to the set that is already present in the data structure. *) + let map_add (v,r) v' map = let zmap = match find_opt v map with | None -> ZMap.empty | Some zmap ->zmap in add v (zmap_add r (TSet.singleton v') zmap) map @@ -263,10 +253,6 @@ module LookupMap (T: Val) = struct let print_map = print_string % show_map - let clone map = - bindings map |> - List.fold_left (fun map (v,node) -> add v node map) (empty) - (** The value at v' is shifted by r and then added for v. The old entry for v' is removed. *) let shift v r v' map = @@ -277,7 +263,7 @@ module LookupMap (T: Val) = struct zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in remove v' (add v zmap map) - (** Find all outgoing edges of v.*) + (** Find all outgoing edges of v in the automata.*) let successors v map = match find_opt v map with | None -> [] @@ -317,14 +303,11 @@ module Term(Var:Val) = struct | Deref (t, _) -> is_subterm st t | _ -> false + (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) let rec contains_variable variables term = match term with | Deref (t, _) -> contains_variable variables t | Addr v -> List.mem v variables - let rec term_depth = function - | Addr _ -> 0 - | Deref (t, _) -> 1 + term_depth t - let rec get_var = function | Addr v -> v | Deref (t, _) -> get_var t @@ -332,6 +315,7 @@ module Term(Var:Val) = struct let default_int_type = IInt let to_cil_constant z = Const (CInt (z, default_int_type, Some (Z.to_string z))) + (** Convert a term to a cil expression and its cil type. *) let rec to_cil off t = let cil_t, vtyp = match t with | Addr v -> AddrOf (Var v, NoOffset), TPtr (v.vtype, []) @@ -340,24 +324,25 @@ module Term(Var:Val) = struct in if Z.(equal zero off) then cil_t, vtyp else BinOp (PlusPI, cil_t, to_cil_constant off, vtyp), vtyp + (** Convert a term to a cil expression. *) let to_cil off t = fst (to_cil off t) - (**Returns an integer from a cil expression and None if the expression is not an integer. *) + (** Returns an integer from a cil expression and None if the expression is not an integer. *) let z_of_exp = function | Const (CInt (i, _, _)) -> Some i | UnOp _ | BinOp _-> (*because we performed constant folding*)None | _ -> None - (**Returns an integer from a cil offset and None if the offset is not an integer. *) + (** Returns an integer from a cil offset and None if the offset is not an integer. *) let rec of_offset = function | NoOffset -> Some Z.zero | Field (fieldinfo, offset) -> (*TODO... ?*)None - | Index (exp, offset) -> match z_of_exp exp, of_offset offset with - | Some c1, Some c2 -> Some Z.(c1 + c2) - | _ -> None + | Index (exp, offset) -> (*TODO... ?*)None - (**Returns Some term, Some offset or None, None if the expression can't be described with our analysis.*) + (** Converts a cil expression to Some term, Some offset; + or None, Some offset is the expression equals an integer, + or None, None if the expression can't be described by our analysis.*) let rec of_cil = function | Const c -> None, z_of_exp (Const c) | Lval lval -> of_lval lval @@ -407,8 +392,8 @@ module Term(Var:Val) = struct | _ -> None, None end - let of_cil = of_cil % Cil.constFold false - + (** Converts the negated expresion to a term if neg = true. + If neg = false then it simply converts the expression to a term. *) let rec of_cil_neg neg e = match e with | UnOp (op,exp,typ)-> begin match op with @@ -417,7 +402,10 @@ module Term(Var:Val) = struct end | _ -> if neg then None, None else of_cil e + let of_cil = of_cil_neg false % Cil.constFold false + let map_z_opt op z = Tuple2.map2 (Option.map (op z)) + (** Converts a cil expression e = "t1 + off1 - (t2 + off2)" to two terms (Some t1, Some off1), (Some t2, Some off2)*) let rec two_terms_of_cil neg e = let pos_t, neg_t = match e with | UnOp (Neg,exp,typ) -> two_terms_of_cil (not neg) exp @@ -445,7 +433,7 @@ module Term(Var:Val) = struct (** `prop_of_cil e pos` parses the expression `e` (or `not e` if `pos = false`) and returns a list of length 1 with the parsed expresion or an empty list if - the expression can't be expressed with the data type `term`. *) + the expression can't be expressed with the data type `prop`. *) let rec prop_of_cil e pos = let e = Cil.constFold false e in match e with @@ -471,7 +459,7 @@ module CongruenceClosure (Var : Val) = struct module TUF = UnionFind (T) module LMap = LookupMap (T) - (** Set of subterms which are present in the current data structure *) + (** Set of subterms which are present in the current data structure. *) module SSet = struct module TSet = ValSet(T) type t = TSet.t [@@deriving eq, ord, hash] @@ -486,6 +474,7 @@ module CongruenceClosure (Var : Val) = struct let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" + (** Adds all subterms of t to the SSet and the LookupMap*) let rec subterms_of_term (set,map) t = match t with | Addr _ -> (add t set, map) | Deref (t',z) -> @@ -493,6 +482,7 @@ module CongruenceClosure (Var : Val) = struct let map = LMap.map_add (t',z) t map in subterms_of_term (set, map) t' + (** Adds all subterms of the proposition to the SSet and the LookupMap*) let subterms_of_prop (set,map) = function | (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 @@ -528,25 +518,25 @@ module CongruenceClosure (Var : Val) = struct let print_min_rep = print_string % show_min_rep - let rec update_min_repr (part, map) min_representatives = function - | [] -> min_representatives, part + let rec update_min_repr (uf, map) min_representatives = function + | [] -> min_representatives, uf | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match LMap.successors state map with | edges -> - let process_edge (min_representatives, queue, part) (edge_z, next_term) = - let next_state, next_z, part = TUF.find part next_term in + let process_edge (min_representatives, queue, uf) (edge_z, next_term) = + let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in match TMap.find_opt next_state min_representatives with | None -> - (add next_state next_min min_representatives, queue @ [next_state], part) + (add next_state next_min min_representatives, queue @ [next_state], uf) | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (add next_state next_min min_representatives, queue @ [next_state], part) - | _ -> (min_representatives, queue, part) + (add next_state next_min min_representatives, queue @ [next_state], uf) + | _ -> (min_representatives, queue, uf) in - let (min_representatives, queue, part) = List.fold_left process_edge (min_representatives, queue, part) edges - in update_min_repr (part, map) min_representatives queue + let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges + in update_min_repr (uf, map) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of the successor nodes of all edges in the queue @@ -557,7 +547,7 @@ module CongruenceClosure (Var : Val) = struct parameters: - - `(part, map)` represent the union find data structure and the corresponding lookup map. + - `(uf, map)` represent the union find data structure and the corresponding lookup map. - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. - `queue` contains the states that need to be processed. The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. @@ -566,38 +556,39 @@ module CongruenceClosure (Var : Val) = struct Returns: - The map with the minimal representatives - The union find tree. This might have changed because of path compression. *) - let update_min_repr (part, map) min_representatives queue = + let update_min_repr (uf, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = - List.sort_unique (fun el1 el2 -> TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root part) queue) - in update_min_repr (part, map) min_representatives queue + List.sort_unique (fun el1 el2 -> TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root uf) queue) + in update_min_repr (uf, map) min_representatives queue (** Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. It's used for now when removing elements, then the min_repr map gets recomputed. + Returns: - The map with the minimal representatives - The union find tree. This might have changed because of path compression. *) - let compute_minimal_representatives (part, set, map) = + let compute_minimal_representatives (uf, set, map) = let atoms = SSet.get_atoms set in (* process all atoms in increasing order *) - let part_ref = ref part in + let uf_ref = ref uf in let atoms = List.sort (fun el1 el2 -> - let v1, z1, new_part = TUF.find !part_ref el1 in - part_ref := new_part; - let v2, z2, new_part = TUF.find !part_ref el2 in - part_ref := new_part; + let v1, z1, new_uf = TUF.find !uf_ref el1 in + uf_ref := new_uf; + let v2, z2, new_uf = TUF.find !uf_ref el2 in + uf_ref := new_uf; TUF.compare_repr (v1, z1) (v2, z2)) atoms in - let add_atom_to_map (min_representatives, queue, part) a = - let (rep, offs, part) = TUF.find part a in + let add_atom_to_map (min_representatives, queue, uf) a = + let (rep, offs, uf) = TUF.find uf a in if not (mem rep min_representatives) then - (add rep (a, offs) min_representatives, queue @ [rep], part) - else (min_representatives, queue, part) + (add rep (a, offs) min_representatives, queue @ [rep], uf) + else (min_representatives, queue, uf) in - let (min_representatives, queue, part) = List.fold_left add_atom_to_map (empty, [], part) atoms + let (min_representatives, queue, uf) = List.fold_left add_atom_to_map (empty, [], uf) atoms (* compute the minimal representative of all remaining edges *) - in update_min_repr (part, map) min_representatives queue + in update_min_repr (uf, map) min_representatives queue (** Computes the initial map of minimal representatives. It maps each element `e` in the set to `(e, 0)`. *) @@ -605,7 +596,7 @@ module CongruenceClosure (Var : Val) = struct List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) end - type t = {part: TUF.t; + type t = {uf: TUF.t; set: SSet.t; map: LMap.t; min_repr: MRMap.t} @@ -614,7 +605,7 @@ module CongruenceClosure (Var : Val) = struct module TMap = ValMap(T) let show_all x = "Union Find partition:\n" ^ - (TUF.show_uf x.part) + (TUF.show_uf x.uf) ^ "\nSubterm set:\n" ^ (SSet.show_set x.set) ^ "\nLookup map/transitions:\n" @@ -634,13 +625,11 @@ module CongruenceClosure (Var : Val) = struct let print_conj = print_string % show_conj (** Returns a list of all the transition that are present in the automata. *) - let get_transitions (part, map) = - List.flatten @@ List.filter_map - (fun (t, imap) -> if TUF.is_root part t then Some - (List.map - (fun (edge_z, res_t) -> - (edge_z, t, TUF.find_no_pc part (LMap.set_any res_t))) @@ - (LMap.zmap_bindings imap)) else None) + let get_transitions (uf, map) = + List.flatten @@ List.map (fun (t, zmap) -> + (List.map (fun (edge_z, res_t) -> + (edge_z, t, TUF.find_no_pc uf (LMap.set_any res_t))) @@ + (LMap.zmap_bindings zmap))) (LMap.bindings map) (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) @@ -653,13 +642,13 @@ module CongruenceClosure (Var : Val) = struct let conjunctions_of_atoms = let atoms = SSet.get_atoms cc.set in List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find_no_pc cc.part atom in + let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in let (min_state, min_z) = MRMap.find rep_state cc.min_repr in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms in let conjunctions_of_transitions = - let transitions = get_transitions (cc.part, cc.map) in + let transitions = get_transitions (cc.uf, cc.map) in List.filter_map (fun (z,s,(s',z')) -> let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in @@ -668,9 +657,9 @@ module CongruenceClosure (Var : Val) = struct in BatList.sort_unique (compare_prop Var.compare) (conjunctions_of_atoms @ conjunctions_of_transitions) (** - returns {part, set, map, min_repr}, where: + returns {uf, set, map, min_repr}, where: - - `part` = empty union find structure where the elements are all subterms occuring in the conjunction. + - `uf` = empty union find structure where the elements are all subterms occuring in the conjunction. - `set` = set of all subterms occuring in the conjunction. @@ -680,17 +669,17 @@ module CongruenceClosure (Var : Val) = struct *) let init_cc conj = let (set, map) = SSet.subterms_of_conj conj in - let part = SSet.elements set |> - TUF.init in + let uf = SSet.elements set |> + TUF.init in let min_repr = MRMap.initial_minimal_representatives set in - {part = part; set = set; map = map ; min_repr = min_repr} + {uf; set; map; min_repr} (** - parameters: (part, map) equalities. + parameters: (uf, map) equalities. - returns updated (part, map, queue), where: + returns updated (uf, map, queue), where: - `part` is the new union find data structure after having added all equalities. + `uf` is the new union find data structure after having added all equalities. `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). @@ -699,16 +688,16 @@ module CongruenceClosure (Var : Val) = struct Throws "Unsat" if a contradiction is found. *) - let rec closure (part, map, min_repr) queue = function - | [] -> (part, map, queue, min_repr) + let rec closure (uf, map, min_repr) queue = function + | [] -> (uf, map, queue, min_repr) | (t1, t2, r)::rest -> - (let v1, r1, part = TUF.find part t1 in - let v2, r2, part = TUF.find part t2 in + (let v1, r1, uf = TUF.find uf t1 in + let v2, r2, uf = TUF.find uf t2 in if T.compare v1 v2 = 0 then (* t1 and t2 are in the same equivalence class *) - if r1 = Z.(r2 + r) then closure (part, map, min_repr) queue rest + if r1 = Z.(r2 + r) then closure (uf, map, min_repr) queue rest else raise Unsat - else let v, part, b = TUF.union part v1 v2 Z.(r2 - r1 + r) in (* union *) + else let v, uf, b = TUF.union uf v1 v2 Z.(r2 - r1 + r) in (* union *) (* update map *) let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with | None, _, false -> map, rest @@ -744,15 +733,17 @@ module CongruenceClosure (Var : Val) = struct let removed_v = if b then v2 else v1 in let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in let queue = v :: queue in - closure (part, map, min_repr) queue rest + closure (uf, map, min_repr) queue rest ) (** - Parameters: (part, map, min_repr) conjunctions. + Parameters: cc conjunctions. + + returns updated cc, where: - returns updated (part, map, min_repr), where: + - `uf` is the new union find data structure after having added all equalities. - - `part` is the new union find data structure after having added all equalities. + - `set` doesn't change - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). @@ -761,9 +752,9 @@ module CongruenceClosure (Var : Val) = struct Throws "Unsat" if a contradiction is found. *) let closure cc conjs = - let (part, map, queue, min_repr) = closure (cc.part, cc.map, cc.min_repr) [] conjs in - let min_repr, part = MRMap.update_min_repr (part, map) min_repr queue in - {part = part; set = cc.set; map = map; min_repr = min_repr} + let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in + let min_repr, uf = MRMap.update_min_repr (uf, map) min_repr queue in + {uf; set = cc.set; map; min_repr} (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) @@ -787,57 +778,53 @@ module CongruenceClosure (Var : Val) = struct (** Add a term to the data structure. - Returns (reference variable, offset), updated (part, set, map, min_repr), + Returns (reference variable, offset), updated (uf, set, map, min_repr), and queue, that needs to be passed as a parameter to `update_min_repr`. - `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. - Therefore it contains either one or zero elements. *) + `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. *) let rec insert_no_min_repr cc t = if SSet.mem t cc.set then - let v,z,part = TUF.find cc.part t in - (v,z), {part = part; set = cc.set; map = cc.map; min_repr = cc.min_repr}, [] + let v,z,uf = TUF.find cc.uf t in + (v,z), {cc with uf}, [] else match t with - | Addr a -> let part = TUF.ValMap.add t ((t, Z.zero),1) cc.part in + | Addr a -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), {part = part; set = set; map = cc.map; min_repr = min_repr}, [Addr a] + (t, Z.zero), {uf; set; map = cc.map; min_repr}, [Addr a] | Deref (t', z) -> let (v, r), cc, queue = insert_no_min_repr cc t' in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in match LMap.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> let v2,z2,part = TUF.find cc.part v' in - let part = LMap.add t ((t, Z.zero),1) part in - (v2,z2), closure {part = part; set = set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr = min_repr} [(t, v', Z.zero)], v::queue + | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in + let uf = LMap.add t ((t, Z.zero),1) uf in + (v2,z2), closure {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr} [(t, v', Z.zero)], v::queue | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in - let part = LMap.add t ((t, Z.zero),1) cc.part in - (t, Z.zero), {part = part; set = set; map = map; min_repr = min_repr}, v::queue + let uf = LMap.add t ((t, Z.zero),1) cc.uf in + (t, Z.zero), {uf; set; map; min_repr}, v::queue (** Add a term to the data structure. - Returns (reference variable, offset), updated (part, set, map, min_repr) *) + Returns (reference variable, offset), updated (uf, set, map, min_repr) *) let insert cc t = let v, cc, queue = insert_no_min_repr cc t in - let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in - v, {part = part; set = cc.set; map = cc.map; min_repr = min_repr} + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.map) cc.min_repr queue in + v, {uf; set = cc.set; map = cc.map; min_repr} (** Add all terms in a specific set to the data structure. - Returns updated (part, set, map, min_repr). *) + Returns updated (uf, set, map, min_repr). *) let insert_set_opt cc t_set = match cc with | None -> None | Some cc -> let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr, part = MRMap.update_min_repr (cc.part, cc.map) cc.min_repr queue in - Some {part; set = cc.set; map = cc.map; min_repr} + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.map) cc.min_repr queue in + Some {uf; set = cc.set; map = cc.map; min_repr} - - (** - Returns true if t1 and t2 are equivalent. - *) + (** Returns true if t1 and t2 are equivalent. *) let eq_query cc (t1,t2,r) = let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in @@ -848,9 +835,7 @@ module CongruenceClosure (Var : Val) = struct | None -> false | Some cc -> fst (eq_query cc (t1,t2,r)) - (** - returns true if t1 and t2 are not equivalent - *) + (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in @@ -859,34 +844,27 @@ module CongruenceClosure (Var : Val) = struct else true else false - - (** - Throws "Unsat" if a contradiction is found. - *) + (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = let cc = insert_set_opt cc (fst (SSet.subterms_of_conj pos_conjs)) in Option.map (fun cc -> closure cc pos_conjs) cc let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs = split conjs in - if List.exists (fun c-> eq_query_opt cc c) neg_conjs then None else + if List.exists (fun c -> eq_query_opt cc c) neg_conjs then None else match meet_conjs cc pos_conjs with | exception Unsat -> None | t -> t - (** - Add proposition t1 = t2 + r to the data structure. - *) + (** Add proposition t1 = t2 + r to the data structure. *) let add_eq cc (t1, t2, r) = - (* should use ineq. for refuting equality *) let (v1, r1), cc = insert cc t1 in let (v2, r2), cc = insert cc t2 in let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in cc - (* remove variables *) - + (* Remove variables: *) let add_to_map_of_children value map term = if T.equal term value then map else @@ -901,19 +879,19 @@ module CongruenceClosure (Var : Val) = struct let add_successor_terms cc t = let add_one_successor (cc, successors) (edge_z, _) = - let _, uf_offset, part = TUF.find cc.part t in - let cc = {cc with part = part} in + let _, uf_offset, uf = TUF.find cc.uf t in + let cc = {cc with uf = uf} in let successor = Deref (t, Z.(edge_z - uf_offset)) in let already_present = SSet.mem successor cc.set in let _, cc, _ = if already_present then (t, Z.zero), cc, [] else insert_no_min_repr cc successor in (cc, if already_present then successors else successor::successors) in - List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.part t)) cc.map) + List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) - (* remove variables *) (** Parameters: - - `cc`: congruence cloösure data structure + - `cc`: congruence closure data structure - `predicate`: predicate that returns true for terms which need to be removed from the data structure. + It takes `uf` as a parameter. Returns: - `new_set`: subset of `set` which contains the terms that do not have to be removed. @@ -925,10 +903,10 @@ module CongruenceClosure (Var : Val) = struct let rec remove_terms_recursive (new_set, removed_terms, map_of_children, cc) = function | [] -> (new_set, removed_terms, map_of_children, cc) | el::rest -> - (* Adds `value` to the set that is in the `map` with key `term` *) - let new_set, removed_terms = if predicate cc.part el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in - let uf_parent = TUF.parent cc.part el in + let new_set, removed_terms = if predicate cc.uf el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in + let uf_parent = TUF.parent cc.uf el in let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in + (* in order to not lose information by removing some elements, we add dereferences values to the union find.*) let cc, successors = add_successor_terms cc el in remove_terms_recursive (new_set, removed_terms, map_of_children, cc) (rest @ successors) in @@ -947,61 +925,61 @@ module CongruenceClosure (Var : Val) = struct (** Removes all terms in "removed_terms" from the union find data structure. Returns: - - `part`: the updated union find tree + - `uf`: the updated union find tree - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. *) - let remove_terms_from_uf part removed_terms map_of_children predicate = - let find_not_removed_element set = match List.find (fun el -> not (predicate part el)) set with + let remove_terms_from_uf uf removed_terms map_of_children predicate = + let find_not_removed_element set = match List.find (fun el -> not (predicate uf el)) set with | exception Not_found -> List.first set | t -> t in - let remove_term (part, new_parents_map, map_of_children) t = + let remove_term (uf, new_parents_map, map_of_children) t = match LMap.find_opt t map_of_children with | None -> (* t has no children, so we can safely delete the element from the data structure *) (* we just need to update the size on the whole path from here to the root *) - let new_parents_map = if TUF.is_root part t then new_parents_map else LMap.add t (TUF.parent part t) new_parents_map in - let parent = fst (TUF.parent part t) in - let map_of_children = if TUF.is_root part t then map_of_children else remove_from_map_of_children parent t map_of_children in - (TUF.ValMap.remove t (TUF.change_size t part pred), new_parents_map, map_of_children) + let new_parents_map = if TUF.is_root uf t then new_parents_map else LMap.add t (TUF.parent uf t) new_parents_map in + let parent = fst (TUF.parent uf t) in + let map_of_children = if TUF.is_root uf t then map_of_children else remove_from_map_of_children parent t map_of_children in + (TUF.ValMap.remove t (TUF.modify_size t uf pred), new_parents_map, map_of_children) | Some children -> let map_of_children = LMap.remove t map_of_children in - if TUF.is_root part t then + if TUF.is_root uf t then (* t is a root and it has some children: 1. choose new root. The new_root is in any case one of the children of the old root. If possible, we choose one of the children that is not going to be deleted. *) let new_root = find_not_removed_element children in let remaining_children = List.remove children new_root in - let offset_new_root = TUF.parent_offset part new_root in + let offset_new_root = TUF.parent_offset uf new_root in (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) - let new_size, map_of_children, part = List.fold - (fun (total_size, map_of_children, part) child -> + let new_size, map_of_children, uf = List.fold + (fun (total_size, map_of_children, uf) child -> (* update parent and offset *) - let part = TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part child - offset_new_root)) in - total_size + TUF.subtree_size part child, add_to_map_of_children child map_of_children new_root, part - ) (0, map_of_children, part) remaining_children in + let uf = TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf child - offset_new_root)) in + total_size + TUF.subtree_size uf child, add_to_map_of_children child map_of_children new_root, uf + ) (0, map_of_children, uf) remaining_children in (* Update new root -> set itself as new parent. *) - let part = TUF.modify_parent part new_root (new_root, Z.zero) in + let uf = TUF.modify_parent uf new_root (new_root, Z.zero) in (* update size of equivalence class *) - let part = TUF.change_size new_root part ((+) new_size) in - (TUF.ValMap.remove t part, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) + let uf = TUF.modify_size new_root uf ((+) new_size) in + (TUF.ValMap.remove t uf, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) else (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) - let (new_root, new_offset) = TUF.parent part t in + let (new_root, new_offset) = TUF.parent uf t in let remaining_children = List.remove children new_root in (* update all parents of the children of t *) - let map_of_children, part = List.fold - (fun (map_of_children, part) child -> + let map_of_children, uf = List.fold + (fun (map_of_children, uf) child -> (* update parent and offset *) add_to_map_of_children child map_of_children new_root, - TUF.modify_parent part child (new_root, Z.(TUF.parent_offset part t + new_offset)) - ) (map_of_children, part) remaining_children in + TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf t + new_offset)) + ) (map_of_children, uf) remaining_children in (* update size of equivalence class *) - let part = TUF.change_size new_root part pred in - (TUF.ValMap.remove t part, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) + let uf = TUF.modify_size new_root uf pred in + (TUF.ValMap.remove t uf, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) in - List.fold_left remove_term (part, LMap.empty, map_of_children) removed_terms + List.fold_left remove_term (uf, LMap.empty, map_of_children) removed_terms let show_new_parents_map new_parents_map = List.fold_left (fun s (v1, (v2, o2)) -> @@ -1010,13 +988,13 @@ module CongruenceClosure (Var : Val) = struct (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) - let rec find_new_root new_parents_map part v = + let rec find_new_root new_parents_map uf v = match LMap.find_opt v new_parents_map with - | None -> TUF.find_opt part v + | None -> TUF.find_opt uf v | Some (new_parent, new_offset) -> - match find_new_root new_parents_map part new_parent with + match find_new_root new_parents_map uf new_parent with | None -> None - | Some (r, o, part) -> Some (r, Z.(o + new_offset), part) + | Some (r, o, uf) -> Some (r, Z.(o + new_offset), uf) (** Removes all terms from the mapped values of this map, for which "predicate" is false. *) @@ -1025,15 +1003,15 @@ module CongruenceClosure (Var : Val) = struct (** For all the elements in the removed terms set, it moves the mapped value to the new root. Returns new map and new union-find*) - let remove_terms_from_map (part, map) removed_terms new_parents_map = - let remove_from_map (map, part) term = + let remove_terms_from_map (uf, map) removed_terms new_parents_map = + let remove_from_map (map, uf) term = match LMap.find_opt term map with - | None -> map, part + | None -> map, uf | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) - match find_new_root new_parents_map part term with - | None -> LMap.remove term map, part - | Some (new_root, new_offset, part) -> LMap.shift new_root new_offset term map, part - in List.fold_left remove_from_map (map, part) removed_terms + match find_new_root new_parents_map uf term with + | None -> LMap.remove term map, uf + | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term map, uf + in List.fold_left remove_from_map (map, uf) removed_terms (** Remove terms from the data structure. It removes all terms for which "predicate" is false, @@ -1043,60 +1021,60 @@ module CongruenceClosure (Var : Val) = struct (* first find all terms that need to be removed *) let set, removed_terms, map_of_children, cc = remove_terms_from_set cc predicate - in let part, new_parents_map, _ = - remove_terms_from_uf cc.part removed_terms map_of_children predicate + in let uf, new_parents_map, _ = + remove_terms_from_uf cc.uf removed_terms map_of_children predicate in let map = - remove_terms_from_mapped_values cc.map (predicate cc.part) - in let map, part = - remove_terms_from_map (part, map) removed_terms new_parents_map - in let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) (show_all old_cc) - (show_all {part; set; map; min_repr}); - {part; set; map; min_repr} + remove_terms_from_mapped_values cc.map (predicate cc.uf) + in let map, uf = + remove_terms_from_map (uf, map) removed_terms new_parents_map + in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + (show_all old_cc) (show_all {uf; set; map; min_repr}); + {uf; set; map; min_repr} (* invertible assignments *) - let shift_uf part map t z off map_of_children = - let t', k1, part = TUF.find part t in + let shift_uf uf map t z off map_of_children = + let t', k1, uf = TUF.find uf t in match LMap.map_find_opt_set (t', Z.(z-k1)) map with - | None -> part + | None -> uf | Some to_be_shifted -> - let shift_element el part = + let shift_element el uf = (* modify parent offset *) - let part = if TUF.is_root part el then part else - TUF.modify_offset part el (fun o -> Z.(o - off)) in + let uf = if TUF.is_root uf el then uf else + TUF.modify_offset uf el (fun o -> Z.(o - off)) in (* modify children offset *) let children = TMap.find el map_of_children in - List.fold_left (fun part child -> TUF.modify_offset part child (Z.(+) off)) part children + List.fold_left (fun uf child -> TUF.modify_offset uf child (Z.(+) off)) uf children in - SSet.fold shift_element to_be_shifted part + SSet.fold shift_element to_be_shifted uf - let shift_subterm part map set t z off map_of_children = - let t', k1, part = TUF.find part t in + let shift_subterm uf map set t z off map_of_children = + let t', k1, uf = TUF.find uf t in match LMap.map_find_opt_set (t', Z.(z-k1)) map with - | None -> part, set, map + | None -> uf, set, map | Some to_be_shifted -> let rec modify_subterm v = match v with | Addr _ -> v | Deref (v', z) -> let z' = if SSet.mem v' to_be_shifted then Z.(z + off) else z in Deref (modify_subterm v', z') in - let shift_element el (part, set, map) = + let shift_element el (uf, set, map) = let new_el = modify_subterm el in (* modify mapping in union find *) - let parent = TUF.ValMap.find el part in - let part = TUF.ValMap.add new_el parent (TUF.ValMap.remove el part) in + let parent = TUF.ValMap.find el uf in + let uf = TUF.ValMap.add new_el parent (TUF.ValMap.remove el uf) in (* modify children *) let children = TMap.find el map_of_children in - let part = List.fold_left (fun part child -> TUF.modify_parent part child (new_el, TUF.parent_offset part child)) part children in + let uf = List.fold_left (fun uf child -> TUF.modify_parent uf child (new_el, TUF.parent_offset uf child)) uf children in (* modify map *) let map = match LMap.find_opt el map with | None -> map | Some entry -> LMap.add new_el entry (LMap.remove el map) - in (part, SSet.add new_el set, map) + in (uf, SSet.add new_el set, map) in - let part, set, map = SSet.fold shift_element to_be_shifted (part, set, map) - in part, set, LMap.map_values map modify_subterm + let uf, set, map = SSet.fold shift_element to_be_shifted (uf, set, map) + in uf, set, LMap.map_values map modify_subterm (** Remove terms from the data structure. @@ -1108,17 +1086,17 @@ module CongruenceClosure (Var : Val) = struct (* first find all terms that need to be removed *) let set, removed_terms, map_of_children, cc = remove_terms_from_set cc predicate - in let part, new_parents_map, map_of_children = - remove_terms_from_uf cc.part removed_terms map_of_children predicate + in let uf, new_parents_map, map_of_children = + remove_terms_from_uf cc.uf removed_terms map_of_children predicate in let map = - remove_terms_from_mapped_values cc.map (predicate cc.part) - in let map, part = - remove_terms_from_map (part, map) removed_terms new_parents_map - in let part = shift_uf part cc.map t z off map_of_children - in let part,set,map = shift_subterm part cc.map set t z off map_of_children - in let min_repr, part = MRMap.compute_minimal_representatives (part, set, map) + remove_terms_from_mapped_values cc.map (predicate cc.uf) + in let map, uf = + remove_terms_from_map (uf, map) removed_terms new_parents_map + in let uf = shift_uf uf cc.map t z off map_of_children + in let uf,set,map = shift_subterm uf cc.map set t z off map_of_children + in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS AND SHIFT: %s\n RESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all {part; set; map; min_repr}); - {part; set; map; min_repr} + (show_all {uf; set; map; min_repr}); + {uf; set; map; min_repr} end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index c48736bb93..77ce8a43ef 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -29,11 +29,11 @@ module Disequalities = struct (T.show t1) AD.pretty mpt1 (T.get_var t1).vid (T.show t2) AD.pretty mpt2 (T.get_var t2).vid (string_of_bool res); res (**Returns true iff by assigning to t1, the value of t2 could change. *) - let rec may_be_equal ask part t1 t2 = + let rec may_be_equal ask uf t1 t2 = match t1, t2 with | CC.Deref (t, z), CC.Deref (v, z') -> - let (q', z1') = TUF.find_no_pc part v in - let (q, z1) = TUF.find_no_pc part t in + let (q', z1') = TUF.find_no_pc uf v in + let (q, z1) = TUF.find_no_pc uf t in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( (not (T.equal q' q) || Z.(equal z (z' + z1 - z1'))) @@ -41,22 +41,22 @@ module Disequalities = struct && (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) ) - || (may_be_equal ask part t1 v) + || (may_be_equal ask uf t1 v) | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) | CC.Addr _ , _ -> T.is_subterm t1 t2 - let may_be_equal ask part t1 t2 = - let res = (may_be_equal ask part t1 t2) in + let may_be_equal ask uf t1 t2 = + let res = (may_be_equal ask uf t1 t2) in if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res (**Returns true iff by assigning to t1, the value of t2 could change. But if we know that t1 and t2 are definitely equal, then it returns false. *) - let rec may_be_equal_but_not_definitely_equal ask part t1 t2 = + let rec may_be_equal_but_not_definitely_equal ask uf t1 t2 = match t1, t2 with | CC.Deref (t, z), CC.Deref (v, z') -> - let (q', z1') = TUF.find_no_pc part v in - let (q, z1) = TUF.find_no_pc part t in + let (q', z1') = TUF.find_no_pc uf v in + let (q, z1) = TUF.find_no_pc uf t in (* If they are in the same equivalence class, then we return false *) ( (not (T.equal q' q)) @@ -64,7 +64,7 @@ module Disequalities = struct && (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) ) - || (may_be_equal ask part t1 v) + || (may_be_equal ask uf t1 v) | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) | CC.Addr _ , _ -> T.is_subterm t1 t2 end @@ -96,7 +96,7 @@ module D = struct | None, None -> true | _ -> false - let empty () = Some {part = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty} + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty} let init () = init_congruence [] @@ -104,7 +104,7 @@ module D = struct let is_bot x = x = None let top () = empty () let is_top = function None -> false - | Some cc -> TUF.is_empty cc.part + | Some cc -> TUF.is_empty cc.uf let join a b = if M.tracing then M.trace "wrpointer" "JOIN\n";a (*TODO implement join*) let widen = join @@ -126,7 +126,7 @@ module D = struct | Some x -> BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) - (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.part))) + (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) @@ -158,7 +158,7 @@ module D = struct let remove_may_equal_terms ask term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = Option.map (fun cc -> (snd(insert cc term))) cc in - Option.map (remove_terms (fun part -> Disequalities.may_be_equal ask part term)) cc + Option.map (remove_terms (fun uf -> Disequalities.may_be_equal ask uf term)) cc (** Remove terms from the data structure and shifts other terms. It removes all terms that may be changed after an assignment to "term". @@ -167,6 +167,6 @@ module D = struct let term = CC.Deref (t, z) in if M.tracing then M.trace "wrpointer" "remove_and_shift_may_equal_terms: %s. Off: %s\n" (T.show term) (Z.to_string off); let cc = Option.map (fun cc -> (snd(insert cc term))) cc in - Option.map (fun cc -> remove_terms_and_shift (fun part -> Disequalities.may_be_equal_but_not_definitely_equal ask part term) cc t z off) cc + Option.map (fun cc -> remove_terms_and_shift (fun uf -> Disequalities.may_be_equal_but_not_definitely_equal ask uf term) cc t z off) cc end From b8a2f677d2bf63488cc5fade5d0b9e78693a9a6f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 22 Apr 2024 11:05:48 +0200 Subject: [PATCH 068/323] fixed bug when inserting new elements. Update min_repr correctly --- src/cdomains/congruenceClosure.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index f289cce702..bf281b4d52 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -697,7 +697,8 @@ module CongruenceClosure (Var : Val) = struct (* t1 and t2 are in the same equivalence class *) if r1 = Z.(r2 + r) then closure (uf, map, min_repr) queue rest else raise Unsat - else let v, uf, b = TUF.union uf v1 v2 Z.(r2 - r1 + r) in (* union *) + else let diff_r = Z.(r2 - r1 + r) in + let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) (* update map *) let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with | None, _, false -> map, rest @@ -730,6 +731,7 @@ module CongruenceClosure (Var : Val) = struct let min_v1, min_v2 = MRMap.find v1 min_repr, MRMap.find v2 min_repr in (* 'changed' is true if the new_min is different than the old min *) let new_min, changed = if fst min_v1 < fst min_v2 then (min_v1, not b) else (min_v2, b) in + let new_min = (fst new_min, if b then Z.(snd new_min - diff_r) else Z.(snd new_min + diff_r)) in let removed_v = if b then v2 else v1 in let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in let queue = v :: queue in From bef1267ce45bfb44f3c36e68b689aa96df10ce52 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 22 Apr 2024 11:57:31 +0200 Subject: [PATCH 069/323] fixed circular dependency in add_successors --- src/cdomains/congruenceClosure.ml | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index bf281b4d52..1554e93c54 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -879,15 +879,26 @@ module CongruenceClosure (Var : Val) = struct | [] -> TMap.remove parent map | new_children -> TMap.add parent new_children map + (* Returns true if any (strict) subterm of t1 is already present in + the same equivalence class as t2. *) + let rec detect_cyclic_dependencies t1 t2 cc = + match t1 with + | Addr v -> false + | Deref (t, _) -> + let v1, o1 = TUF.find_no_pc cc.uf t1 in + let v2, o2 = TUF.find_no_pc cc.uf t2 in + if v1 = v2 then true else + detect_cyclic_dependencies t t2 cc + let add_successor_terms cc t = let add_one_successor (cc, successors) (edge_z, _) = let _, uf_offset, uf = TUF.find cc.uf t in let cc = {cc with uf = uf} in let successor = Deref (t, Z.(edge_z - uf_offset)) in - let already_present = SSet.mem successor cc.set in - let _, cc, _ = if already_present then (t, Z.zero), cc, [] + let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in + let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] else insert_no_min_repr cc successor in - (cc, if already_present then successors else successor::successors) in + (cc, if subterm_already_present then successors else successor::successors) in List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) (** Parameters: From d9faf49b8c8957a4247773ea25df6e0bd2ae5693 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 22 Apr 2024 12:34:45 +0200 Subject: [PATCH 070/323] fixed all comparison functions --- .../weaklyRelationalPointerAnalysis.ml | 2 +- src/cdomains/congruenceClosure.ml | 22 ++++++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 6 ++--- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 411b6cb561..b28494c611 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -53,7 +53,7 @@ struct (* Indefinite assignment *) | (Some lterm, Some loffset), (None, _) -> D.remove_may_equal_terms ask lterm t (* Definite assignment *) - | (Some lterm, Some loffset), (Some term, Some offset) when Z.compare loffset Z.zero = 0 -> + | (Some lterm, Some loffset), (Some term, Some offset) when Z.equal loffset Z.zero -> if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s + %s; expr: %s + %s\n" (T.show lterm) (Z.to_string loffset) (T.show term) (Z.to_string offset); t |> meet_conjs_opt [Equal (Disequalities.dummy_var, term, offset)] |> D.remove_may_equal_terms ask lterm |> diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 1554e93c54..2fc4df4256 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -64,7 +64,7 @@ module UnionFind (Val: Val) = struct let (p, old_size) = ValMap.find t uf in let uf = ValMap.add t (p, modification old_size) uf in let parent = fst p in - if parent = t then uf else modify_size parent uf modification + if Val.equal parent t then uf else modify_size parent uf modification let modify_parent uf v (t, offset) = let (_, size) = ValMap.find v uf in @@ -141,7 +141,7 @@ module UnionFind (Val: Val) = struct *) let rec find_no_pc uf v = let (v',r') = parent uf v in - if Val.compare v' v = 0 then + if Val.equal v' v then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) @@ -170,7 +170,7 @@ module UnionFind (Val: Val) = struct let v1,r1,uf = find uf v'1 in let v2,r2,uf = find uf v'2 in if Val.equal v1 v2 then - if r1 = Z.(r2 + r) then v1, uf, true + if Z.(equal r1 (r2 + r)) then v1, uf, true else raise (Failure "incomparable union") else let (_,s1), (_,s2) = ValMap.find v1 uf, ValMap.find v2 uf in if s1 <= s2 then ( @@ -292,6 +292,8 @@ module Term(Var:Val) = struct type t = Var.t term [@@deriving eq, ord, hash] type v_prop = Var.t prop [@@deriving eq, ord, hash] + let props_equal = List.equal equal_v_prop + let rec show = function | Addr v -> "&" ^ Var.show v | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v @@ -637,7 +639,7 @@ module CongruenceClosure (Var : Val) = struct (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = let normalize_equality (t1, t2, z) = - if t1 = t2 && Z.(compare z zero) = 0 then None else + if T.equal t1 t2 && Z.(equal z zero) then None else Some (Equal (t1, t2, z)) in let conjunctions_of_atoms = let atoms = SSet.get_atoms cc.set in @@ -693,9 +695,9 @@ module CongruenceClosure (Var : Val) = struct | (t1, t2, r)::rest -> (let v1, r1, uf = TUF.find uf t1 in let v2, r2, uf = TUF.find uf t2 in - if T.compare v1 v2 = 0 then + if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) - if r1 = Z.(r2 + r) then closure (uf, map, min_repr) queue rest + if Z.equal r1 Z.(r2 + r) then closure (uf, map, min_repr) queue rest else raise Unsat else let diff_r = Z.(r2 - r1 + r) in let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) @@ -830,7 +832,7 @@ module CongruenceClosure (Var : Val) = struct let eq_query cc (t1,t2,r) = let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in - (T.compare v1 v2 = 0 && r1 = Z.(r2 + r), cc) + (T.equal v1 v2 && Z.equal r1 Z.(r2 + r), cc) let eq_query_opt cc (t1,t2,r) = match cc with @@ -841,8 +843,8 @@ module CongruenceClosure (Var : Val) = struct let neq_query cc (t1,t2,r) = let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in - if T.compare v1 v2 = 0 then - if r1 = Z.(r2 + r) then false + if T.equal v1 v2 then + if Z.(equal r1 (r2 + r)) then false else true else false @@ -887,7 +889,7 @@ module CongruenceClosure (Var : Val) = struct | Deref (t, _) -> let v1, o1 = TUF.find_no_pc cc.uf t1 in let v2, o2 = TUF.find_no_pc cc.uf t2 in - if v1 = v2 then true else + if T.equal v1 v2 then true else detect_cyclic_dependencies t t2 cc let add_successor_terms cc t = diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 77ce8a43ef..9ab5cd0004 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -18,7 +18,7 @@ module Disequalities = struct (**Find out if two addresses are possibly equal by using the MayPointTo query*) let may_point_to_same_address (ask:Queries.ask) t1 t2 off = - if t1 = t2 then true else + if T.equal t1 t2 then true else if Var.equal dummy_varinfo (T.get_var t1) || Var.equal dummy_varinfo (T.get_var t2) then false else let exp1 = T.to_cil Z.zero t1 in let exp2 = T.to_cil off t2 in @@ -92,7 +92,7 @@ module D = struct let equal x y = if M.tracing then M.trace "wrpointer-equal" "equal.\nx=\n%s\ny=\n%s" (show x) (show y); match x, y with | Some x, Some y -> - (get_normal_form x = get_normal_form y) + (T.props_equal (get_normal_form x) (get_normal_form y)) | None, None -> true | _ -> false @@ -101,7 +101,7 @@ module D = struct let init () = init_congruence [] let bot () = None - let is_bot x = x = None + let is_bot x = Option.is_none x let top () = empty () let is_top = function None -> false | Some cc -> TUF.is_empty cc.uf From b9fec264f999ddc19d08f7f07a034bc76ff24133 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 22 Apr 2024 12:43:45 +0200 Subject: [PATCH 071/323] fixed comparison for List.remove --- src/cdomains/congruenceClosure.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2fc4df4256..0e8e9e792b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -877,7 +877,7 @@ module CongruenceClosure (Var : Val) = struct | Some list -> TMap.add term (value::list) map let remove_from_map_of_children parent child map = - match List.remove (TMap.find parent map) child with + match List.remove_if (T.equal child) (TMap.find parent map) with | [] -> TMap.remove parent map | new_children -> TMap.add parent new_children map @@ -965,7 +965,7 @@ module CongruenceClosure (Var : Val) = struct The new_root is in any case one of the children of the old root. If possible, we choose one of the children that is not going to be deleted. *) let new_root = find_not_removed_element children in - let remaining_children = List.remove children new_root in + let remaining_children = List.remove_if (T.equal new_root) children in let offset_new_root = TUF.parent_offset uf new_root in (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) let new_size, map_of_children, uf = List.fold @@ -982,7 +982,7 @@ module CongruenceClosure (Var : Val) = struct else (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) let (new_root, new_offset) = TUF.parent uf t in - let remaining_children = List.remove children new_root in + let remaining_children = List.remove_if (T.equal new_root) children in (* update all parents of the children of t *) let map_of_children, uf = List.fold (fun (map_of_children, uf) child -> From 7279db945ae7f5d4a3aa28a9f77fe6dee925f4b0 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 23 Apr 2024 17:00:35 +0200 Subject: [PATCH 072/323] convert cil expression to term --- .../weaklyRelationalPointerAnalysis.ml | 30 ++- src/cdomains/congruenceClosure.ml | 246 ++++++++++++------ 2 files changed, 187 insertions(+), 89 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index b28494c611..63488924cd 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -23,11 +23,11 @@ struct (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, and None if we don't know anyhing. *) - let eval_guard t e = + let eval_guard ask t e = match t with None -> Some false | Some t -> - let prop_list = T.prop_of_cil e true in + let prop_list = T.prop_of_cil ask e true in let res = match split prop_list with | [], [] -> None | x::xs, _ -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None @@ -38,36 +38,37 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in match q with - | EvalInt e -> begin match eval_guard ctx.local e with + | EvalInt e -> begin match eval_guard (ask_of_ctx ctx) ctx.local e with | None -> Result.top q | Some res -> let ik = Cilfacade.get_ikind_exp e in ID.of_bool ik res end - (* TODO what is type a + (* TODO what is type a-> C expression, see in Queries in queries.ml -> baically its a cil expression | Queries.Invariant context -> get_normal_form context*) | _ -> Result.top q let assign_lval t ask lval expr = - match T.of_lval lval, T.of_cil expr with + match T.of_lval ask lval, T.of_cil ask expr with (* Indefinite assignment *) - | (Some lterm, Some loffset), (None, _) -> D.remove_may_equal_terms ask lterm t + | lterm, (None, _) -> D.remove_may_equal_terms ask lterm t (* Definite assignment *) - | (Some lterm, Some loffset), (Some term, Some offset) when Z.equal loffset Z.zero -> - if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s + %s; expr: %s + %s\n" (T.show lterm) (Z.to_string loffset) (T.show term) (Z.to_string offset); + | lterm, (Some term, Some offset) -> + if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s\n" (T.show lterm) (T.show term) (Z.to_string offset); t |> meet_conjs_opt [Equal (Disequalities.dummy_var, term, offset)] |> D.remove_may_equal_terms ask lterm |> meet_conjs_opt [Equal (lterm, Disequalities.dummy_var, Z.zero)] |> D.remove_terms_containing_variable Disequalities.dummy_var (* invertibe assignment *) + | exception (T.UnsupportedCilExpression _) -> t | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in - if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_exp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res + if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res let branch ctx e pos = - let props = T.prop_of_cil e pos in + let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let res = meet_conjs_opt props ctx.local in if D.is_bot res then raise Deadcode; if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; prop_list: %s\n" @@ -76,16 +77,16 @@ struct let body ctx f = ctx.local (*DONE*) - let assign_return t return_var expr = + let assign_return ask t return_var expr = (* the return value is not stored on the heap, therefore we don't need to remove any terms *) - match T.of_cil expr with + match T.of_cil ask expr with | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] (insert_set_opt t (SSet.TSet.of_list [return_var; term])) | _ -> t let return ctx exp_opt f = let res = match exp_opt with | Some e -> - assign_return ctx.local Disequalities.dummy_var e + assign_return (ask_of_ctx ctx) ctx.local Disequalities.dummy_var e | None -> ctx.local in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Disequalities.dummy_lval) exp_opt) (D.show ctx.local) (D.show res);res @@ -110,6 +111,8 @@ struct if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); [ctx.local, new_state] + (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t + expr funktionsaufruf*) let combine_env ctx var_opt expr f exprs t_context_opt t ask = let local_vars = f.sformals @ f.slocals in let t = D.meet ctx.local t in @@ -117,6 +120,7 @@ struct D.remove_terms_containing_variables local_vars t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res + (*ctx.local is after combine_env, t callee*) let combine_assign ctx var_opt expr f exprs t_context_opt t ask = let ask = (ask_of_ctx ctx) in let t' = combine_env ctx var_opt expr f exprs t_context_opt t ask in diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 0e8e9e792b..8ea6531be2 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -300,6 +300,12 @@ module Term(Var:Val) = struct | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" + let rec show_v = function + | Addr v -> "&" ^ v.vname + | Deref (Addr v, z) when Z.equal z Z.zero -> v.vname + | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show_v t + | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show_v t ^ ")" + (** Returns true if the first parameter is a subterm of the second one. *) let rec is_subterm st term = equal st term || match term with | Deref (t, _) -> is_subterm st t @@ -314,15 +320,30 @@ module Term(Var:Val) = struct | Addr v -> v | Deref (t, _) -> get_var t + exception UnsupportedCilExpression of string + let default_int_type = IInt let to_cil_constant z = Const (CInt (z, default_int_type, Some (Z.to_string z))) - (** Convert a term to a cil expression and its cil type. *) + (** TODO: Convert a term to a cil expression and its cil type. *) let rec to_cil off t = let cil_t, vtyp = match t with | Addr v -> AddrOf (Var v, NoOffset), TPtr (v.vtype, []) | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset), v.vtype - | Deref (t, z) -> let cil_t, vtyp = to_cil z t in Lval (Mem cil_t, NoOffset), TPtr (vtyp, []) + | Deref (t, z) -> + let cil_t, vtyp = to_cil z t in + begin match vtyp with + | TPtr (typ,_) -> Lval (Mem cil_t, NoOffset), typ + | TArray (typ, length, _) -> Lval (Mem cil_t, NoOffset), typ (*TODO**) + | TComp (_, _) -> cil_t, vtyp(*TODO**) + | TVoid _ + | TInt (_, _) + | TFloat (_, _) + | TFun (_, _, _, _) + | TNamed (_, _) + | TEnum (_, _) + | TBuiltin_va_list _ -> cil_t, vtyp + end in if Z.(equal zero off) then cil_t, vtyp else BinOp (PlusPI, cil_t, to_cil_constant off, vtyp), vtyp @@ -331,116 +352,187 @@ module Term(Var:Val) = struct (** Returns an integer from a cil expression and None if the expression is not an integer. *) let z_of_exp = function - | Const (CInt (i, _, _)) -> Some i - | UnOp _ - | BinOp _-> (*because we performed constant folding*)None - | _ -> None + | Const (CInt (i, _, _)) -> i + | _-> (*because we performed constant folding*) + raise (UnsupportedCilExpression "non-constant value") + + let eval_int (ask:Queries.ask) exp = + match Cilfacade.get_ikind_exp exp with + | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") + | ikind -> + begin match ask.f (Queries.EvalInt exp) with + | `Lifted i -> + begin match IntDomain.IntDomTuple.to_int @@ IntDomain.IntDomTuple.cast_to ikind i + with + | Some i -> i + | None -> raise (UnsupportedCilExpression "non-constant value") + end + | _ -> raise (UnsupportedCilExpression "non-constant value") + end + + let eval_int_opt (ask:Queries.ask) exp = + match eval_int ask exp with + | i -> Some i + | exception (UnsupportedCilExpression _) -> None + + let rec get_size_in_bits ask typ = + match typ with + | TArray (typ, _, _) -> get_size_in_bits ask typ + | _ -> Z.(eval_int ask (SizeOf typ) * (of_int 8)) + + let get_exp_size_in_bits ask exp = + Z.(eval_int ask (SizeOfE exp) * (of_int 8)) - (** Returns an integer from a cil offset and None if the offset is not an integer. *) - let rec of_offset = function - | NoOffset -> Some Z.zero - | Field (fieldinfo, offset) -> (*TODO... ?*)None - | Index (exp, offset) -> (*TODO... ?*)None + let is_array_type = function + | TArray _ -> true + | _ -> false + + let is_struct_type = function + | TComp _ -> true + | _ -> false + + let rec of_index ask t var_type curr_offs = + let get_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with + | Some i -> i + | None -> raise (UnsupportedCilExpression "unknown offset") + in + let rec type_len_array ask = function + | TArray (arr_type, Some exp, _) -> arr_type, eval_int ask exp + | _ -> raise (UnsupportedCilExpression "incoherent type of variable") in + function + | Index (exp, NoOffset) -> + let new_var_type, len_array = type_len_array ask var_type in + let var_size = get_size_in_bits ask new_var_type in + let z' = Z.(eval_int ask exp * var_size) in + t, Z.(curr_offs * len_array + z'), new_var_type + | Index (exp, off) -> + let new_var_type, len_array = type_len_array ask var_type in + let var_size = get_size_in_bits ask new_var_type in + let z' = Z.(eval_int ask exp * var_size) in + let t, z'', new_var_type = of_index ask t new_var_type Z.(curr_offs * len_array + z') off in + t, z'', new_var_type + | Field (finfo, off) -> let field_offset = get_offset finfo in + let t, z'', new_var_type = of_index ask t finfo.ftype Z.zero off in + t, Z.(curr_offs + field_offset + z''), new_var_type + | NoOffset -> t, curr_offs, var_type + + let rec of_offset ask t var_type off = + if off == NoOffset then t else + let t, z, var_type = of_index ask t var_type Z.zero off in + if not (is_array_type var_type) then Deref (t, z) + else raise (UnsupportedCilExpression "this is an address") (** Converts a cil expression to Some term, Some offset; or None, Some offset is the expression equals an integer, or None, None if the expression can't be described by our analysis.*) - let rec of_cil = function - | Const c -> None, z_of_exp (Const c) - | Lval lval -> of_lval lval + let rec of_cil (ask:Queries.ask) e = match e with + | Const _ -> None, Z.(get_exp_size_in_bits ask e * z_of_exp e) | AlignOf _ - | AlignOfE _ -> (*no idea*) None, None - | StartOf lval -> of_lval lval - | AddrOf (Var var, NoOffset) -> Some (Addr var), Some Z.zero - | AddrOf (Mem exp, NoOffset) -> of_cil exp + | AlignOfE _ -> raise (UnsupportedCilExpression "unsupported AlignOf") + | Lval lval -> Some (of_lval ask lval), Z.zero + | StartOf lval -> Some (of_lval ask lval), Z.zero + | AddrOf (Var var, NoOffset) -> Some (Addr var), Z.zero + | AddrOf (Mem exp, NoOffset) -> of_cil ask exp | UnOp (op,exp,typ)-> begin match op with - | Neg -> begin match of_cil exp with - | None, Some off -> None, Some Z.(-off) - | _ -> None, None - end - | _ -> None, None + | Neg -> let typ_size = get_size_in_bits ask typ in + let off = eval_int ask exp in None, Z.(-off * typ_size) + | _ -> raise (UnsupportedCilExpression "unsupported UnOp") end | BinOp (binop, exp1, exp2, typ)-> begin match binop with | PlusA | PlusPI - | IndexPI -> begin match of_cil exp1, of_cil exp2 with - | (None, Some off1), (Some term, Some off2) - | (Some term, Some off1), (None, Some off2) -> Some term, Some Z.(off1 + off2) - | _ -> None, None + | IndexPI -> + let typ_size = get_size_in_bits ask typ in + let typ1_size = get_exp_size_in_bits ask exp1 in + let typ2_size = get_exp_size_in_bits ask exp2 in + begin match eval_int_opt ask exp1, eval_int_opt ask exp2 with + | None, None -> raise (UnsupportedCilExpression "unsupported BinOp +") + | None, Some off2 -> let term, off1 = of_cil ask exp1 in term, Z.(off1 + typ2_size * off2) + | Some off1, None -> let term, off2 = of_cil ask exp2 in term, Z.(typ1_size * off1 + off2) + | Some off1, Some off2 -> None, Z.(typ_size * (off1 + off2)) end | MinusA | MinusPI - | MinusPP -> begin match of_cil exp1, of_cil exp2 with - | (Some term, Some off1), (None, Some off2) -> Some term, Some Z.(off1 - off2) - | _ -> None, None + | MinusPP -> begin match of_cil ask exp1, of_cil ask exp2 with + | (Some term, off1), (None, off2) -> Some term, Z.(off1 - off2) + | _ -> raise (UnsupportedCilExpression "unsupported BinOp -") end - | Eq -> None, None - | Ne -> None, None - | _ -> None, None - end - | CastE (typ, exp)-> of_cil exp - | AddrOf lval -> (*TODO*)None, None - | _ -> None, None - and of_lval = function - | (Var var, NoOffset) -> Some (Deref (Addr var, Z.zero)), Some Z.zero - | (Var var, Index (exp, NoOffset)) -> begin match of_cil exp with - | None, Some off -> Some (Deref ((Deref (Addr var, Z.zero)), off)), Some Z.zero - | _ -> None, None - end - | (Var var, _) -> None, None (*TODO: Index with Offset, and Field*) - | (Mem exp, offset) -> - begin match of_cil exp, of_offset offset with - | (Some term, Some offset), Some z_offset -> Some (Deref (term, offset)), Some z_offset - | _ -> None, None + | _ -> raise (UnsupportedCilExpression "unsupported BinOp") end + | CastE (typ, exp)-> let old_size = get_exp_size_in_bits ask exp in + let new_size = get_exp_size_in_bits ask e in + let t, off = of_cil ask exp in t, Z.(off * new_size / old_size) + | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") + and of_lval ask lval =let res = match lval with + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) var.vtype off + else + of_offset ask (Deref (Addr var, Z.zero)) var.vtype off + | (Mem exp, off) -> + begin match of_cil ask exp with + | (Some term, offset) -> of_offset ask (Deref (term, offset)) (*TODO type of mem -> remove pointer from exp type*)(TInt (default_int_type, [])) off + | _ -> raise (UnsupportedCilExpression "cannot dereference constant") + end in + (if M.tracing then match res with + | exception (UnsupportedCilExpression s) -> M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s + | t -> M.trace "wrpointer-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show_v t)) + ;res (** Converts the negated expresion to a term if neg = true. If neg = false then it simply converts the expression to a term. *) - let rec of_cil_neg neg e = match e with + let rec of_cil_neg ask neg e = match e with | UnOp (op,exp,typ)-> begin match op with - | Neg -> of_cil_neg (not neg) exp - | _ -> if neg then None, None else of_cil e + | Neg -> of_cil_neg ask (not neg) exp + | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e end - | _ -> if neg then None, None else of_cil e + | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e - let of_cil = of_cil_neg false % Cil.constFold false + let of_cil_neg ask neg e = let res = match of_cil_neg ask neg (Cil.constFold false e) with + | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; + None, None + | t, z -> t, Some z + in (if M.tracing && not neg then match res with + | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) + | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show_v t) (Z.to_string z) + | _ -> M.trace "wrpointer-cil-conversion" "This is impossible. exp: %a\n" d_plainexp e); res + + let of_cil ask e = of_cil_neg ask false e let map_z_opt op z = Tuple2.map2 (Option.map (op z)) (** Converts a cil expression e = "t1 + off1 - (t2 + off2)" to two terms (Some t1, Some off1), (Some t2, Some off2)*) - let rec two_terms_of_cil neg e = + let rec two_terms_of_cil ask neg e = let pos_t, neg_t = match e with - | UnOp (Neg,exp,typ) -> two_terms_of_cil (not neg) exp + | UnOp (Neg,exp,typ) -> two_terms_of_cil ask (not neg) exp | BinOp (binop, exp1, exp2, typ)-> begin match binop with | PlusA | PlusPI - | IndexPI -> begin match of_cil exp1 with - | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil true exp2 in + | IndexPI -> begin match of_cil ask exp1 with + | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask true exp2 in map_z_opt Z.(+) off1 pos_t, neg_t - | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg true exp2 + | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask true exp2 | _ -> (None, None), (None, None) end | MinusA | MinusPI - | MinusPP -> begin match of_cil exp1 with - | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil false exp2 in + | MinusPP -> begin match of_cil ask exp1 with + | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask false exp2 in map_z_opt Z.(+) off1 pos_t, neg_t - | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg false exp2 - | _ -> of_cil e, (None, Some Z.zero) + | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask false exp2 + | _ -> of_cil ask e, (None, Some Z.zero) end - | _ -> of_cil e, (None, Some Z.zero) + | _ -> of_cil ask e, (None, Some Z.zero) end - | _ -> of_cil e, (None, Some Z.zero) + | _ -> of_cil ask e, (None, Some Z.zero) in if neg then neg_t, pos_t else pos_t, neg_t (** `prop_of_cil e pos` parses the expression `e` (or `not e` if `pos = false`) and returns a list of length 1 with the parsed expresion or an empty list if the expression can't be expressed with the data type `prop`. *) - let rec prop_of_cil e pos = + let rec prop_of_cil ask e pos = let e = Cil.constFold false e in match e with | BinOp (r, e1, e2, _) -> - begin match two_terms_of_cil false (BinOp (MinusPI, e1, e2, TInt (Cilfacade.get_ikind_exp e,[]))) with + begin match two_terms_of_cil ask false (BinOp (MinusPI, e1, e2, TInt (Cilfacade.get_ikind_exp e,[]))) with | ((Some t1, Some z1), (Some t2, Some z2)) -> begin match r with | Eq -> if pos then [Equal (t1, t2, Z.(z2-z1))] else [Nequal (t1, t2, Z.(z2-z1))] @@ -449,7 +541,7 @@ module Term(Var:Val) = struct end | _,_ -> [] end - | UnOp (LNot, e1, _) -> prop_of_cil e1 (not pos) + | UnOp (LNot, e1, _) -> prop_of_cil ask e1 (not pos) | _ -> [] end @@ -606,15 +698,6 @@ module CongruenceClosure (Var : Val) = struct module TMap = ValMap(T) - let show_all x = "Union Find partition:\n" ^ - (TUF.show_uf x.uf) - ^ "\nSubterm set:\n" - ^ (SSet.show_set x.set) - ^ "\nLookup map/transitions:\n" - ^ (LMap.show_map x.map) - ^ "\nMinimal representatives:\n" - ^ (MRMap.show_min_rep x.min_repr) - let string_of_prop = function | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 @@ -658,6 +741,17 @@ module CongruenceClosure (Var : Val) = struct ) transitions in BatList.sort_unique (compare_prop Var.compare) (conjunctions_of_atoms @ conjunctions_of_transitions) + let show_all x = "Normal form:\n" ^ + show_conj((get_normal_form x)) ^ + "Union Find partition:\n" ^ + (TUF.show_uf x.uf) + ^ "\nSubterm set:\n" + ^ (SSet.show_set x.set) + ^ "\nLookup map/transitions:\n" + ^ (LMap.show_map x.map) + ^ "\nMinimal representatives:\n" + ^ (MRMap.show_min_rep x.min_repr) + (** returns {uf, set, map, min_repr}, where: From 92e6b47f259ad8ffd26fa64d292f283493ad3d1e Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 23 Apr 2024 17:02:04 +0200 Subject: [PATCH 073/323] fix test case --- tests/regression/79-wrpointer/10-different-types.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/tests/regression/79-wrpointer/10-different-types.c b/tests/regression/79-wrpointer/10-different-types.c index 8638f1215b..0e98964a72 100644 --- a/tests/regression/79-wrpointer/10-different-types.c +++ b/tests/regression/79-wrpointer/10-different-types.c @@ -4,7 +4,7 @@ void main(void) { // no problem if they are all ints - int *ipt = (int *)malloc(sizeof(long)); + int *ipt = (int *)malloc(sizeof(int)); int *ipt2; int i; *ipt = i; @@ -27,9 +27,12 @@ void main(void) { // *lpt: 24832; l: 0 __goblint_check(*lpt == l); // UNKNOWN! + + l = 0; *lpt = l; // *lpt: 0; l: 0 __goblint_check(*lpt == l); + *((char *)lpt + 1) = 'a'; // *lpt: 24832; l: 0 __goblint_check(*lpt == l); // UNKNOWN! } From 48179e26235d730792e6f7ba1f9bbcb388f3f422 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 23 Apr 2024 17:03:35 +0200 Subject: [PATCH 074/323] add tests with structs and arrays --- .../regression/79-wrpointer/13-experiments.c | 45 +++++++++++++ .../79-wrpointer/15-arrays-structs.c | 67 +++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 tests/regression/79-wrpointer/13-experiments.c create mode 100644 tests/regression/79-wrpointer/15-arrays-structs.c diff --git a/tests/regression/79-wrpointer/13-experiments.c b/tests/regression/79-wrpointer/13-experiments.c new file mode 100644 index 0000000000..951276fa2c --- /dev/null +++ b/tests/regression/79-wrpointer/13-experiments.c @@ -0,0 +1,45 @@ +// PARAM: --set ana.activated[+] wrpointer +#include +#include + +struct Pair { + int (*first)[7]; + int second; +}; + +struct Crazy { + int whatever; + int arr[5]; +}; + +void main(void) { + int arr[7] = {1, 2, 3, 4, 5, 6, 7}; + int(*x)[7] = (int(*)[7])malloc(sizeof(int)); + struct Pair p; + p.first = x; + p.second = (*x)[3]; + + struct Pair p2; + p2.first = x; + + __goblint_check(p.first == p2.first); + + int arr2[2][2] = {{1, 2}, {1, 2}}; + p.second = arr2[1][1]; + + // int *test; + + // int *x2[2] = {test, test}; + + // int test2 = *(x2[1]); + + struct Crazy crazyy[3][2]; + + int a = crazyy[2][1].arr[4]; + int b = ((struct Crazy *)crazyy)[5].arr[4]; + + __goblint_check(a == b); + + int *sx[4]; + int k = *sx[1]; +} diff --git a/tests/regression/79-wrpointer/15-arrays-structs.c b/tests/regression/79-wrpointer/15-arrays-structs.c new file mode 100644 index 0000000000..6df66d92d2 --- /dev/null +++ b/tests/regression/79-wrpointer/15-arrays-structs.c @@ -0,0 +1,67 @@ + +// PARAM: --set ana.activated[+] wrpointer +#include +#include + +struct mystruct { + int first; + int second; +}; + +struct arrstruct { + int first[3]; + int second[3]; +}; + +void main(void) { + // array of struct + struct mystruct arrayStructs[3]; + + // printf("%d == %d \n", arrayStructs[2].first, ((int *)arrayStructs)[3]); + __goblint_check(arrayStructs[0].first == + ((int *)arrayStructs)[0]); // they are the same element + __goblint_check(arrayStructs[1].second == + ((int *)arrayStructs)[3]); // they are the same element + __goblint_check(arrayStructs[2].first == + ((int *)arrayStructs)[4]); // they are the same element + + // struct of array + struct arrstruct structArray; + int *pstruct = (int *)&structArray; // pointer to struct + __goblint_check(structArray.first[0] == + pstruct[0]); // they are the same element + __goblint_check(structArray.first[2] == + pstruct[2]); // they are the same element + __goblint_check(structArray.second[0] == + pstruct[3]); // they are the same element + __goblint_check(structArray.second[2] == + pstruct[5]); // they are the same element + + // array of array + int array2D[2][2] = {{1, 2}, {3, 4}}; + __goblint_check(array2D[0][0] == + *((int *)array2D + 0)); // they are the same element + __goblint_check(array2D[1][0] == + *((int *)array2D + 2)); // they are the same element + __goblint_check(array2D[1][1] == + *((int *)array2D + 3)); // they are the same element + + // arr2D[0][1] is the element and arr2D[2] is a pointer to an array + __goblint_check(array2D[0][1] == (long)array2D[2]); // UNKNOWN! + + __goblint_check((int *)array2D[0] + 4 == (int *)array2D[2]); + __goblint_check((int *)array2D + 4 == (int *)array2D[2]); + + __goblint_check(array2D[1][2] == *((int *)array2D + 4)); + __goblint_check((int *)array2D + 4 == (int *)array2D[2]); + + // 3D array + int array3D[2][3][4] ; + // = { + // {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}, + // {{13, 14, 15, 16}, {17, 18, 19, 20}, {21, 22, 23, 24}}}; + __goblint_check(array3D[1][0][3] == *((int *)array3D + 15)); + __goblint_check(array3D[1][2][0] == *((int *)array3D + 20)); + __goblint_check(array3D[1][2][3] == *((int *)array3D + 23)); + __goblint_check(array3D[0][1][1] == *((int *)array3D + 5)); +} From 230f4c9123bd4c616fbd723b78eef66264213896 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 24 Apr 2024 14:33:41 +0200 Subject: [PATCH 075/323] adapted some test cases --- .../79-wrpointer/06-invertible-assignment.c | 6 +-- .../79-wrpointer/07-invertible-assignment2.c | 26 ++++++++----- .../79-wrpointer/08-simple-assignment.c | 6 +-- tests/regression/79-wrpointer/11-array.c | 38 +++++++------------ .../regression/79-wrpointer/13-experiments.c | 5 +-- 5 files changed, 37 insertions(+), 44 deletions(-) diff --git a/tests/regression/79-wrpointer/06-invertible-assignment.c b/tests/regression/79-wrpointer/06-invertible-assignment.c index ba29f3767e..94bccbec78 100644 --- a/tests/regression/79-wrpointer/06-invertible-assignment.c +++ b/tests/regression/79-wrpointer/06-invertible-assignment.c @@ -2,9 +2,9 @@ #include void main(void) { - int *i; - int **j; - int *k; + long *i; + long **j; + long *k; j = &k + 1; j++; __goblint_check(j == &k + 2); diff --git a/tests/regression/79-wrpointer/07-invertible-assignment2.c b/tests/regression/79-wrpointer/07-invertible-assignment2.c index d8d18bd5ac..1c82f3cc40 100644 --- a/tests/regression/79-wrpointer/07-invertible-assignment2.c +++ b/tests/regression/79-wrpointer/07-invertible-assignment2.c @@ -1,18 +1,26 @@ // PARAM: --set ana.activated[+] wrpointer -// example of the paper "2-Pointer Logic" by Seidl et al., pag. 22 +// example of the paper "2-Pointer Logic" by Seidl et al., Example 9, pag. 22 +#include #include void main(void) { - int x; - int *z = &x; - int y = -1 + x; + int *x = (int*)malloc(sizeof(int)); + int **z = (int**)malloc(sizeof(int*)); + *z = x; + int *y = (int*)malloc(sizeof(int*)); + int top; + if(top){ + y = (int*)z; + *x = (long)z; + } + *y = -1 + *x; - __goblint_check(z == &x); - __goblint_check(y == -1 + x); + __goblint_check(*z == x); + __goblint_check(*y == -1 + *x); - *z = 1 + x, + **z = 1 + *x; - __goblint_check(&x == z); - __goblint_check(y == -2 + x); + __goblint_check(x == *z); + __goblint_check(*y == -2 + *x); } diff --git a/tests/regression/79-wrpointer/08-simple-assignment.c b/tests/regression/79-wrpointer/08-simple-assignment.c index 45d2de90c4..ac93b0a4e2 100644 --- a/tests/regression/79-wrpointer/08-simple-assignment.c +++ b/tests/regression/79-wrpointer/08-simple-assignment.c @@ -3,12 +3,12 @@ #include void main(void) { - int x; - int *z = -1 + &x; + long x; + long *z = -1 + &x; __goblint_check(z == -1 + &x); - z = (int*) *(1 + z); + z = (long*) *(1 + z); __goblint_check(x == (long)z); diff --git a/tests/regression/79-wrpointer/11-array.c b/tests/regression/79-wrpointer/11-array.c index 222239cfe0..62e4fe5c1c 100644 --- a/tests/regression/79-wrpointer/11-array.c +++ b/tests/regression/79-wrpointer/11-array.c @@ -3,34 +3,22 @@ #include void main(void) { - int i[6][5]; int m[5]; - i[3][1] = m[2]; + int **j; + int *l; + j = (int **)malloc(sizeof(int *) + 7); + j[3] = (int *)malloc(sizeof(int)); + int *k; + l = j[3]; + j[0] = k; + j[2] = m; - __goblint_check(i[3][1] == m[2]); + __goblint_check(**j == *k); + __goblint_check(l == *(j + 3)); + __goblint_check(j[2] == m); - int i2[6]; - int m2[5]; + j = &k + 1; - i2[3] = m2[2]; - - __goblint_check(i2[3] == m2[2]); - -// int **j; -// int *l; -// j = (int **)malloc(sizeof(int *) + 7); -// j[3] = (int *)malloc(sizeof(int)); -// int *k; -// l = j[3]; -// j[0] = k; -// j[2] = m; - -// __goblint_check(**j == *k); -// __goblint_check(l == *(j + 3)); -// __goblint_check(j[2] == m); - -// j = &k + 1; - -// __goblint_check(j == &k); // FAIL + __goblint_check(j == &k); // FAIL } diff --git a/tests/regression/79-wrpointer/13-experiments.c b/tests/regression/79-wrpointer/13-experiments.c index 951276fa2c..2f5f77f160 100644 --- a/tests/regression/79-wrpointer/13-experiments.c +++ b/tests/regression/79-wrpointer/13-experiments.c @@ -35,10 +35,7 @@ void main(void) { struct Crazy crazyy[3][2]; - int a = crazyy[2][1].arr[4]; - int b = ((struct Crazy *)crazyy)[5].arr[4]; - - __goblint_check(a == b); + __goblint_check(crazyy[2][1].arr[4] == ((struct Crazy *)crazyy)[5].arr[4]); int *sx[4]; int k = *sx[1]; From 0e4e214613e68dcc1ce6b119122f9e612f0ae0e5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 24 Apr 2024 14:35:19 +0200 Subject: [PATCH 076/323] rewrite conversion to cil from a term and adapted conversion from cil expression --- src/cdomains/congruenceClosure.ml | 118 ++++++++++-------- src/cdomains/weaklyRelationalPointerDomain.ml | 20 +-- 2 files changed, 79 insertions(+), 59 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 8ea6531be2..9800eb07d0 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -322,34 +322,6 @@ module Term(Var:Val) = struct exception UnsupportedCilExpression of string - let default_int_type = IInt - let to_cil_constant z = Const (CInt (z, default_int_type, Some (Z.to_string z))) - - (** TODO: Convert a term to a cil expression and its cil type. *) - let rec to_cil off t = - let cil_t, vtyp = match t with - | Addr v -> AddrOf (Var v, NoOffset), TPtr (v.vtype, []) - | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset), v.vtype - | Deref (t, z) -> - let cil_t, vtyp = to_cil z t in - begin match vtyp with - | TPtr (typ,_) -> Lval (Mem cil_t, NoOffset), typ - | TArray (typ, length, _) -> Lval (Mem cil_t, NoOffset), typ (*TODO**) - | TComp (_, _) -> cil_t, vtyp(*TODO**) - | TVoid _ - | TInt (_, _) - | TFloat (_, _) - | TFun (_, _, _, _) - | TNamed (_, _) - | TEnum (_, _) - | TBuiltin_va_list _ -> cil_t, vtyp - end - in if Z.(equal zero off) then cil_t, vtyp else - BinOp (PlusPI, cil_t, to_cil_constant off, vtyp), vtyp - - (** Convert a term to a cil expression. *) - let to_cil off t = fst (to_cil off t) - (** Returns an integer from a cil expression and None if the expression is not an integer. *) let z_of_exp = function | Const (CInt (i, _, _)) -> i @@ -375,14 +347,15 @@ module Term(Var:Val) = struct | i -> Some i | exception (UnsupportedCilExpression _) -> None + (**Returns the size of the type. If typ is a pointer, it returns the + size of the elements it points to. If typ is an array, it returns the ize of the + elements of the array (even if it is a multidimensional array. Therefore get_size_in_bits int[][][] = sizeof(int)). *) let rec get_size_in_bits ask typ = match typ with | TArray (typ, _, _) -> get_size_in_bits ask typ + | TPtr (typ, _) -> Z.(eval_int ask (SizeOf typ) * (of_int 8)) | _ -> Z.(eval_int ask (SizeOf typ) * (of_int 8)) - let get_exp_size_in_bits ask exp = - Z.(eval_int ask (SizeOfE exp) * (of_int 8)) - let is_array_type = function | TArray _ -> true | _ -> false @@ -391,6 +364,10 @@ module Term(Var:Val) = struct | TComp _ -> true | _ -> false + let is_struct_ptr_type = function + | TPtr(TComp _,_) -> true + | _ -> false + let rec of_index ask t var_type curr_offs = let get_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with | Some i -> i @@ -416,9 +393,9 @@ module Term(Var:Val) = struct t, Z.(curr_offs + field_offset + z''), new_var_type | NoOffset -> t, curr_offs, var_type - let rec of_offset ask t var_type off = + let rec of_offset ask t var_type off initial_offs = if off == NoOffset then t else - let t, z, var_type = of_index ask t var_type Z.zero off in + let t, z, var_type = of_index ask t var_type initial_offs off in if not (is_array_type var_type) then Deref (t, z) else raise (UnsupportedCilExpression "this is an address") @@ -426,7 +403,7 @@ module Term(Var:Val) = struct or None, Some offset is the expression equals an integer, or None, None if the expression can't be described by our analysis.*) let rec of_cil (ask:Queries.ask) e = match e with - | Const _ -> None, Z.(get_exp_size_in_bits ask e * z_of_exp e) + | Const _ -> None, Z.(z_of_exp e) | AlignOf _ | AlignOfE _ -> raise (UnsupportedCilExpression "unsupported AlignOf") | Lval lval -> Some (of_lval ask lval), Z.zero @@ -434,42 +411,46 @@ module Term(Var:Val) = struct | AddrOf (Var var, NoOffset) -> Some (Addr var), Z.zero | AddrOf (Mem exp, NoOffset) -> of_cil ask exp | UnOp (op,exp,typ)-> begin match op with - | Neg -> let typ_size = get_size_in_bits ask typ in - let off = eval_int ask exp in None, Z.(-off * typ_size) + | Neg -> let off = eval_int ask exp in None, Z.(-off) | _ -> raise (UnsupportedCilExpression "unsupported UnOp") end - | BinOp (binop, exp1, exp2, typ)-> begin match binop with + | BinOp (binop, exp1, exp2, typ)-> + let typ1_size = get_size_in_bits ask (Cilfacade.typeOf exp1) in + let typ2_size = get_size_in_bits ask (Cilfacade.typeOf exp2) in + begin match binop with | PlusA | PlusPI | IndexPI -> - let typ_size = get_size_in_bits ask typ in - let typ1_size = get_exp_size_in_bits ask exp1 in - let typ2_size = get_exp_size_in_bits ask exp2 in begin match eval_int_opt ask exp1, eval_int_opt ask exp2 with | None, None -> raise (UnsupportedCilExpression "unsupported BinOp +") - | None, Some off2 -> let term, off1 = of_cil ask exp1 in term, Z.(off1 + typ2_size * off2) - | Some off1, None -> let term, off2 = of_cil ask exp2 in term, Z.(typ1_size * off1 + off2) - | Some off1, Some off2 -> None, Z.(typ_size * (off1 + off2)) + | None, Some off2 -> let term, off1 = of_cil ask exp1 in term, Z.(off1 + typ1_size * off2) + | Some off1, None -> let term, off2 = of_cil ask exp2 in term, Z.(typ2_size * off1 + off2) + | Some off1, Some off2 -> None, Z.(off1 + off2) end | MinusA | MinusPI - | MinusPP -> begin match of_cil ask exp1, of_cil ask exp2 with - | (Some term, off1), (None, off2) -> Some term, Z.(off1 - off2) + | MinusPP -> begin match of_cil ask exp1, eval_int_opt ask exp2 with + | (Some term, off1), Some off2 -> let typ1_size = get_size_in_bits ask (Cilfacade.typeOf exp1) in + Some term, Z.(off1 - typ1_size * off2) | _ -> raise (UnsupportedCilExpression "unsupported BinOp -") end | _ -> raise (UnsupportedCilExpression "unsupported BinOp") end - | CastE (typ, exp)-> let old_size = get_exp_size_in_bits ask exp in - let new_size = get_exp_size_in_bits ask e in + | CastE (typ, exp)-> let old_size = get_size_in_bits ask (Cilfacade.typeOf exp) in + let new_size = get_size_in_bits ask (Cilfacade.typeOf e) in let t, off = of_cil ask exp in t, Z.(off * new_size / old_size) | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") - and of_lval ask lval =let res = match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) var.vtype off + and of_lval ask lval = let res = match lval with + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) var.vtype off Z.zero else - of_offset ask (Deref (Addr var, Z.zero)) var.vtype off + of_offset ask (Deref (Addr var, Z.zero)) var.vtype off Z.zero | (Mem exp, off) -> begin match of_cil ask exp with - | (Some term, offset) -> of_offset ask (Deref (term, offset)) (*TODO type of mem -> remove pointer from exp type*)(TInt (default_int_type, [])) off + | (Some term, offset) -> + let typ = Cilfacade.typeOf exp in + if is_struct_ptr_type typ then of_offset ask term typ off offset + else + of_offset ask (Deref (term, offset)) typ off Z.zero | _ -> raise (UnsupportedCilExpression "cannot dereference constant") end in (if M.tracing then match res with @@ -544,6 +525,41 @@ module Term(Var:Val) = struct | UnOp (LNot, e1, _) -> prop_of_cil ask e1 (not pos) | _ -> [] + + let default_int_type = IInt + let to_cil_constant ask z t = let z = Z.(z/ get_size_in_bits ask t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) + + (** TODO: Convert a term to a cil expression and its cil type. *) + let rec to_cil ask off t = + let cil_t, vtyp = match t with + | Addr v -> AddrOf (Var v, NoOffset), TPtr (v.vtype, []) + | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset), v.vtype + | Deref (t, z) -> + let cil_t, vtyp = to_cil ask z t in + begin match vtyp with + | TPtr (typ,_) -> Lval (Mem cil_t, NoOffset), typ + | TArray (typ, length, _) -> Lval (Mem (CastE (TPtr (typ,[]), cil_t)), NoOffset), typ (*TODO**) + | TComp (icomp, _) -> Lval (Mem cil_t, NoOffset), (List.first icomp.cfields).ftype(*TODO**) + | TVoid _ + | TInt (_, _) + | TFloat (_, _) + | TFun (_, _, _, _) + | TNamed (_, _) + | TEnum (_, _) + | TBuiltin_va_list _ -> cil_t, vtyp + end + in if Z.(equal zero off) then cil_t, vtyp else + match vtyp with + | TArray (typ, length, _) -> cil_t, vtyp + | _ -> + BinOp (PlusPI, cil_t, to_cil_constant ask off vtyp, vtyp), vtyp + + (** Convert a term to a cil expression. *) + let to_cil ask off t = let exp, typ = to_cil ask off t in + if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Offset: %s; Exp: %a; Typ: %a\n" + (show_v t) (Z.to_string off) d_plainexp exp d_plaintype typ; + exp + end (** Quantitative congruence closure on terms *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 9ab5cd0004..6763ce0747 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -19,14 +19,18 @@ module Disequalities = struct (**Find out if two addresses are possibly equal by using the MayPointTo query*) let may_point_to_same_address (ask:Queries.ask) t1 t2 off = if T.equal t1 t2 then true else - if Var.equal dummy_varinfo (T.get_var t1) || Var.equal dummy_varinfo (T.get_var t2) then false else - let exp1 = T.to_cil Z.zero t1 in - let exp2 = T.to_cil off t2 in - let mpt1 = ask.f (MayPointTo exp1) in - let mpt2 = ask.f (MayPointTo exp2) in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; res: %a; var1: %d;\nt2: %s; res: %a; var2: %d;\nresult: %s\n" - (T.show t1) AD.pretty mpt1 (T.get_var t1).vid (T.show t2) AD.pretty mpt2 (T.get_var t2).vid (string_of_bool res); res + (* two local arrays can never point to the same array *) + let are_different_arrays = match t1, t2 with + | Deref (Addr x1, z1), Deref (Addr x2, z2) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false + | _ -> false in + if are_different_arrays || Var.equal dummy_varinfo (T.get_var t1) || Var.equal dummy_varinfo (T.get_var t2) then false else + let exp1 = T.to_cil ask Z.zero t1 in + let exp2 = T.to_cil ask off t2 in + let mpt1 = ask.f (MayPointTo exp1) in + let mpt2 = ask.f (MayPointTo exp2) in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; exp1: %a; res: %a; var1: %d;\nt2: %s; exp2: %a; res: %a; var2: %d;\nresult: %s\n" + (T.show t1) d_plainexp exp1 AD.pretty mpt1 (T.get_var t1).vid (T.show t2) d_plainexp exp2 AD.pretty mpt2 (T.get_var t2).vid (string_of_bool res); res (**Returns true iff by assigning to t1, the value of t2 could change. *) let rec may_be_equal ask uf t1 t2 = From 845975569a3d9b4215daa05745feb57bd1b2c5e4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 24 Apr 2024 15:49:14 +0200 Subject: [PATCH 077/323] identify overlapping pointers --- src/cdomains/congruenceClosure.ml | 58 +++++++++++++------ src/cdomains/weaklyRelationalPointerDomain.ml | 5 +- 2 files changed, 44 insertions(+), 19 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9800eb07d0..9f56085cd2 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -347,14 +347,17 @@ module Term(Var:Val) = struct | i -> Some i | exception (UnsupportedCilExpression _) -> None + let rec get_size_in_bits ask typ = + Z.(eval_int ask (SizeOf typ) * (of_int 8)) + (**Returns the size of the type. If typ is a pointer, it returns the size of the elements it points to. If typ is an array, it returns the ize of the - elements of the array (even if it is a multidimensional array. Therefore get_size_in_bits int[][][] = sizeof(int)). *) - let rec get_size_in_bits ask typ = + elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int[][][] = sizeof(int)). *) + let rec get_element_size_in_bits ask typ = match typ with - | TArray (typ, _, _) -> get_size_in_bits ask typ - | TPtr (typ, _) -> Z.(eval_int ask (SizeOf typ) * (of_int 8)) - | _ -> Z.(eval_int ask (SizeOf typ) * (of_int 8)) + | TArray (typ, _, _) -> get_element_size_in_bits ask typ + | TPtr (typ, _) -> get_size_in_bits ask typ + | _ -> get_size_in_bits ask typ let is_array_type = function | TArray _ -> true @@ -368,27 +371,46 @@ module Term(Var:Val) = struct | TPtr(TComp _,_) -> true | _ -> false + let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with + | Some i -> i + | None -> raise (UnsupportedCilExpression "unknown offset") + + let rec type_of_term = + let get_field_at_index z = + List.find (fun field -> Z.equal (get_field_offset field) z) + in function + | (Addr x) -> TPtr (x.vtype,[]) + | (Deref (Addr x, z)) -> begin match x.vtype with + | TComp (cinfo, _) -> (get_field_at_index z cinfo.cfields).ftype + | _ -> x.vtype + end + | (Deref (t, z)) -> begin match type_of_term t with + | TPtr (typ, _) -> typ + | typ -> let rec remove_array_and_struct_types = function + | TArray (typ, _, _) -> remove_array_and_struct_types typ + | TComp (cinfo, _) -> raise (UnsupportedCilExpression "not supported yet") (*TODO*) + | typ -> typ + in remove_array_and_struct_types typ + end + + let rec of_index ask t var_type curr_offs = - let get_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with - | Some i -> i - | None -> raise (UnsupportedCilExpression "unknown offset") - in let rec type_len_array ask = function | TArray (arr_type, Some exp, _) -> arr_type, eval_int ask exp | _ -> raise (UnsupportedCilExpression "incoherent type of variable") in function | Index (exp, NoOffset) -> let new_var_type, len_array = type_len_array ask var_type in - let var_size = get_size_in_bits ask new_var_type in + let var_size = get_element_size_in_bits ask new_var_type in let z' = Z.(eval_int ask exp * var_size) in t, Z.(curr_offs * len_array + z'), new_var_type | Index (exp, off) -> let new_var_type, len_array = type_len_array ask var_type in - let var_size = get_size_in_bits ask new_var_type in + let var_size = get_element_size_in_bits ask new_var_type in let z' = Z.(eval_int ask exp * var_size) in let t, z'', new_var_type = of_index ask t new_var_type Z.(curr_offs * len_array + z') off in t, z'', new_var_type - | Field (finfo, off) -> let field_offset = get_offset finfo in + | Field (finfo, off) -> let field_offset = get_field_offset finfo in let t, z'', new_var_type = of_index ask t finfo.ftype Z.zero off in t, Z.(curr_offs + field_offset + z''), new_var_type | NoOffset -> t, curr_offs, var_type @@ -415,8 +437,8 @@ module Term(Var:Val) = struct | _ -> raise (UnsupportedCilExpression "unsupported UnOp") end | BinOp (binop, exp1, exp2, typ)-> - let typ1_size = get_size_in_bits ask (Cilfacade.typeOf exp1) in - let typ2_size = get_size_in_bits ask (Cilfacade.typeOf exp2) in + let typ1_size = get_element_size_in_bits ask (Cilfacade.typeOf exp1) in + let typ2_size = get_element_size_in_bits ask (Cilfacade.typeOf exp2) in begin match binop with | PlusA | PlusPI @@ -430,14 +452,14 @@ module Term(Var:Val) = struct | MinusA | MinusPI | MinusPP -> begin match of_cil ask exp1, eval_int_opt ask exp2 with - | (Some term, off1), Some off2 -> let typ1_size = get_size_in_bits ask (Cilfacade.typeOf exp1) in + | (Some term, off1), Some off2 -> let typ1_size = get_element_size_in_bits ask (Cilfacade.typeOf exp1) in Some term, Z.(off1 - typ1_size * off2) | _ -> raise (UnsupportedCilExpression "unsupported BinOp -") end | _ -> raise (UnsupportedCilExpression "unsupported BinOp") end - | CastE (typ, exp)-> let old_size = get_size_in_bits ask (Cilfacade.typeOf exp) in - let new_size = get_size_in_bits ask (Cilfacade.typeOf e) in + | CastE (typ, exp)-> let old_size = get_element_size_in_bits ask (Cilfacade.typeOf exp) in + let new_size = get_element_size_in_bits ask (Cilfacade.typeOf e) in let t, off = of_cil ask exp in t, Z.(off * new_size / old_size) | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") and of_lval ask lval = let res = match lval with @@ -527,7 +549,7 @@ module Term(Var:Val) = struct let default_int_type = IInt - let to_cil_constant ask z t = let z = Z.(z/ get_size_in_bits ask t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) + let to_cil_constant ask z t = let z = Z.(z/ get_element_size_in_bits ask t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) (** TODO: Convert a term to a cil expression and its cil type. *) let rec to_cil ask off t = diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 6763ce0747..03c8613ab9 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -38,9 +38,12 @@ module Disequalities = struct | CC.Deref (t, z), CC.Deref (v, z') -> let (q', z1') = TUF.find_no_pc uf v in let (q, z1) = TUF.find_no_pc uf t in + let s = T.get_size_in_bits ask (T.type_of_term t) in + let s' = T.get_size_in_bits ask (T.type_of_term v) in + let diff = Z.(-z' - z1 + z1' + z) in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( - (not (T.equal q' q) || Z.(equal z (z' + z1 - z1'))) + (not (T.equal q' q) || Z.(lt diff s && lt (-s') diff)) (* or if we know that they are not equal according to the query MayPointTo*) && (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) From 9ceaf2ae2357714e353a1fc260da97c384c27dce Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 24 Apr 2024 16:28:41 +0200 Subject: [PATCH 078/323] use bitSizeOf instead of ask (EvalInt (SizeOf...)) --- src/cdomains/congruenceClosure.ml | 27 +++++++++---------- src/cdomains/weaklyRelationalPointerDomain.ml | 4 +-- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9f56085cd2..4b9daa6db2 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -347,17 +347,16 @@ module Term(Var:Val) = struct | i -> Some i | exception (UnsupportedCilExpression _) -> None - let rec get_size_in_bits ask typ = - Z.(eval_int ask (SizeOf typ) * (of_int 8)) + let rec get_size_in_bits typ = Z.of_int (bitsSizeOf typ) (**Returns the size of the type. If typ is a pointer, it returns the size of the elements it points to. If typ is an array, it returns the ize of the elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int[][][] = sizeof(int)). *) - let rec get_element_size_in_bits ask typ = + let rec get_element_size_in_bits typ = match typ with - | TArray (typ, _, _) -> get_element_size_in_bits ask typ - | TPtr (typ, _) -> get_size_in_bits ask typ - | _ -> get_size_in_bits ask typ + | TArray (typ, _, _) -> get_element_size_in_bits typ + | TPtr (typ, _) -> get_size_in_bits typ + | _ -> get_size_in_bits typ let is_array_type = function | TArray _ -> true @@ -401,12 +400,12 @@ module Term(Var:Val) = struct function | Index (exp, NoOffset) -> let new_var_type, len_array = type_len_array ask var_type in - let var_size = get_element_size_in_bits ask new_var_type in + let var_size = get_element_size_in_bits new_var_type in let z' = Z.(eval_int ask exp * var_size) in t, Z.(curr_offs * len_array + z'), new_var_type | Index (exp, off) -> let new_var_type, len_array = type_len_array ask var_type in - let var_size = get_element_size_in_bits ask new_var_type in + let var_size = get_element_size_in_bits new_var_type in let z' = Z.(eval_int ask exp * var_size) in let t, z'', new_var_type = of_index ask t new_var_type Z.(curr_offs * len_array + z') off in t, z'', new_var_type @@ -437,8 +436,8 @@ module Term(Var:Val) = struct | _ -> raise (UnsupportedCilExpression "unsupported UnOp") end | BinOp (binop, exp1, exp2, typ)-> - let typ1_size = get_element_size_in_bits ask (Cilfacade.typeOf exp1) in - let typ2_size = get_element_size_in_bits ask (Cilfacade.typeOf exp2) in + let typ1_size = get_element_size_in_bits (Cilfacade.typeOf exp1) in + let typ2_size = get_element_size_in_bits (Cilfacade.typeOf exp2) in begin match binop with | PlusA | PlusPI @@ -452,14 +451,14 @@ module Term(Var:Val) = struct | MinusA | MinusPI | MinusPP -> begin match of_cil ask exp1, eval_int_opt ask exp2 with - | (Some term, off1), Some off2 -> let typ1_size = get_element_size_in_bits ask (Cilfacade.typeOf exp1) in + | (Some term, off1), Some off2 -> let typ1_size = get_element_size_in_bits (Cilfacade.typeOf exp1) in Some term, Z.(off1 - typ1_size * off2) | _ -> raise (UnsupportedCilExpression "unsupported BinOp -") end | _ -> raise (UnsupportedCilExpression "unsupported BinOp") end - | CastE (typ, exp)-> let old_size = get_element_size_in_bits ask (Cilfacade.typeOf exp) in - let new_size = get_element_size_in_bits ask (Cilfacade.typeOf e) in + | CastE (typ, exp)-> let old_size = get_element_size_in_bits (Cilfacade.typeOf exp) in + let new_size = get_element_size_in_bits (Cilfacade.typeOf e) in let t, off = of_cil ask exp in t, Z.(off * new_size / old_size) | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") and of_lval ask lval = let res = match lval with @@ -549,7 +548,7 @@ module Term(Var:Val) = struct let default_int_type = IInt - let to_cil_constant ask z t = let z = Z.(z/ get_element_size_in_bits ask t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) + let to_cil_constant ask z t = let z = Z.(z/ get_element_size_in_bits t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) (** TODO: Convert a term to a cil expression and its cil type. *) let rec to_cil ask off t = diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 03c8613ab9..0d943e8d92 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -38,8 +38,8 @@ module Disequalities = struct | CC.Deref (t, z), CC.Deref (v, z') -> let (q', z1') = TUF.find_no_pc uf v in let (q, z1) = TUF.find_no_pc uf t in - let s = T.get_size_in_bits ask (T.type_of_term t) in - let s' = T.get_size_in_bits ask (T.type_of_term v) in + let s = T.get_size_in_bits (T.type_of_term t) in + let s' = T.get_size_in_bits (T.type_of_term v) in let diff = Z.(-z' - z1 + z1' + z) in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( From 132efa94d87d128f90f5c0a0d6e78df92713d443 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 25 Apr 2024 14:21:44 +0200 Subject: [PATCH 079/323] added an analysis of initial values of variables --- src/analyses/startStateAnalysis.ml | 62 +++++++++++++++++++ .../weaklyRelationalPointerAnalysis.ml | 2 +- 2 files changed, 63 insertions(+), 1 deletion(-) create mode 100644 src/analyses/startStateAnalysis.ml diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml new file mode 100644 index 0000000000..693d251e64 --- /dev/null +++ b/src/analyses/startStateAnalysis.ml @@ -0,0 +1,62 @@ +(** Remebers the Value of each parameter at the beginning of each function. + Used by the wrpointer anaylysis. *) + +open GoblintCil +open Analyses + + +(*First all local variables of the function are duplicated (by negating their ID), + then we remember the value of each local variable at the beginning of the function + in this new duplicated variable. *) +module Spec : Analyses.MCPSpec = +struct + let name () = "startState" + module VD = BaseDomain.VD + module AD = ValueDomain.AD + module Value = AD + module D = MapDomain.MapBot (Basetype.Variables) (Value) + module C = D + + include Analyses.IdentitySpec + + let duplicated_variable var = { var with vid = - var.vid } + + let get_value (ask: Queries.ask) exp = ask.f (MayPointTo exp) + + (** If e is a known variable, then it returns the value for this variable. + If e is an unknown variable, then it returns bot. + If e is another expression that is not simply a ariable, then it returns top. *) + let eval (ask: Queries.ask) (d: D.t) (exp: exp): Value.t = match exp with + | Lval (Var x, NoOffset) -> begin match D.find_opt x d with + | Some v -> v + | None -> Value.top() + end + | AddrOf (Var x, NoOffset) -> get_value ask (AddrOf (Var (duplicated_variable x), NoOffset)) + | _ -> Value.top () + + let startstate v = D.bot () + let exitstate = startstate + + let query ctx (type a) (q: a Queries.t): a Queries.result = + let open Queries in + match q with + | MayPointTo e -> eval (ask_of_ctx ctx) ctx.local e + | EvalValue e -> Address (eval (ask_of_ctx ctx) ctx.local e) + | _ -> Result.top q + + let enter ctx var_opt f args = + (* assign function parameters *) + [ctx.local, ctx.local] + + let body ctx (f:fundec) = + List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in + if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; + D.add var value st) (D.empty()) (List.map duplicated_variable f.sformals) + + let combine_env ctx var_opt expr f exprs t_context_opt t ask = + ctx.local + +end + +let _ = + MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 63488924cd..89e9241fc8 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -137,4 +137,4 @@ struct end let _ = - MCP.register_analysis (module Spec : MCPSpec) + MCP.register_analysis ~dep:["startState"] (module Spec : MCPSpec) From a168133acac7a5c9e13dba867166a344ea39358b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 25 Apr 2024 14:25:27 +0200 Subject: [PATCH 080/323] added the new analysis startState to the tests --- tests/regression/79-wrpointer/01-simple.c | 2 +- tests/regression/79-wrpointer/02-rel-simple.c | 2 +- tests/regression/79-wrpointer/03-function-call.c | 7 +++++-- tests/regression/79-wrpointer/04-remove-vars.c | 5 +++-- tests/regression/79-wrpointer/05-branch.c | 2 +- tests/regression/79-wrpointer/06-invertible-assignment.c | 2 +- tests/regression/79-wrpointer/07-invertible-assignment2.c | 2 +- tests/regression/79-wrpointer/08-simple-assignment.c | 2 +- tests/regression/79-wrpointer/09-different-offsets.c | 2 +- tests/regression/79-wrpointer/10-different-types.c | 2 +- tests/regression/79-wrpointer/11-array.c | 2 +- tests/regression/79-wrpointer/12-rel-function.c | 2 +- tests/regression/79-wrpointer/13-experiments.c | 2 +- tests/regression/79-wrpointer/15-arrays-structs.c | 2 +- 14 files changed, 20 insertions(+), 16 deletions(-) diff --git a/tests/regression/79-wrpointer/01-simple.c b/tests/regression/79-wrpointer/01-simple.c index 605cf3bb18..094067f9e4 100644 --- a/tests/regression/79-wrpointer/01-simple.c +++ b/tests/regression/79-wrpointer/01-simple.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include diff --git a/tests/regression/79-wrpointer/02-rel-simple.c b/tests/regression/79-wrpointer/02-rel-simple.c index 10050240cd..26abcdad70 100644 --- a/tests/regression/79-wrpointer/02-rel-simple.c +++ b/tests/regression/79-wrpointer/02-rel-simple.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include #include diff --git a/tests/regression/79-wrpointer/03-function-call.c b/tests/regression/79-wrpointer/03-function-call.c index b89fce9e9c..4b3077c571 100644 --- a/tests/regression/79-wrpointer/03-function-call.c +++ b/tests/regression/79-wrpointer/03-function-call.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include @@ -6,9 +6,12 @@ int *i; int **j; -int *f(int **a, int *b) { return *a; } +int *f(int **a, int *b) { + //a=...;//find tainted vars + return *a; } int main(void) { + j = (int **)malloc(sizeof(int *)); *j = (int *)malloc(sizeof(int)); int *k = f(j, i); diff --git a/tests/regression/79-wrpointer/04-remove-vars.c b/tests/regression/79-wrpointer/04-remove-vars.c index b2cb5282df..34fde4d0bb 100644 --- a/tests/regression/79-wrpointer/04-remove-vars.c +++ b/tests/regression/79-wrpointer/04-remove-vars.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include @@ -12,7 +12,8 @@ int *f(int **j) { int main(void) { int *i; - int **j = (int**)malloc(sizeof(int*)); + int **j; + j = (int**)malloc(sizeof(int*)); *j = (int *)malloc(sizeof(int)); int *k = f(j); diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/79-wrpointer/05-branch.c index b3cc4e1988..7d26e8759a 100644 --- a/tests/regression/79-wrpointer/05-branch.c +++ b/tests/regression/79-wrpointer/05-branch.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include void main(void) { diff --git a/tests/regression/79-wrpointer/06-invertible-assignment.c b/tests/regression/79-wrpointer/06-invertible-assignment.c index 94bccbec78..c961b1400f 100644 --- a/tests/regression/79-wrpointer/06-invertible-assignment.c +++ b/tests/regression/79-wrpointer/06-invertible-assignment.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include void main(void) { diff --git a/tests/regression/79-wrpointer/07-invertible-assignment2.c b/tests/regression/79-wrpointer/07-invertible-assignment2.c index 1c82f3cc40..1763df71de 100644 --- a/tests/regression/79-wrpointer/07-invertible-assignment2.c +++ b/tests/regression/79-wrpointer/07-invertible-assignment2.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState // example of the paper "2-Pointer Logic" by Seidl et al., Example 9, pag. 22 #include #include diff --git a/tests/regression/79-wrpointer/08-simple-assignment.c b/tests/regression/79-wrpointer/08-simple-assignment.c index ac93b0a4e2..5ba3acb087 100644 --- a/tests/regression/79-wrpointer/08-simple-assignment.c +++ b/tests/regression/79-wrpointer/08-simple-assignment.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState // example of the paper "2-Pointer Logic" by Seidl et al., pag. 21 #include diff --git a/tests/regression/79-wrpointer/09-different-offsets.c b/tests/regression/79-wrpointer/09-different-offsets.c index 7025a5f7d7..3e9e226268 100644 --- a/tests/regression/79-wrpointer/09-different-offsets.c +++ b/tests/regression/79-wrpointer/09-different-offsets.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include diff --git a/tests/regression/79-wrpointer/10-different-types.c b/tests/regression/79-wrpointer/10-different-types.c index 0e98964a72..b765c5dc78 100644 --- a/tests/regression/79-wrpointer/10-different-types.c +++ b/tests/regression/79-wrpointer/10-different-types.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include diff --git a/tests/regression/79-wrpointer/11-array.c b/tests/regression/79-wrpointer/11-array.c index 62e4fe5c1c..549b2ab92a 100644 --- a/tests/regression/79-wrpointer/11-array.c +++ b/tests/regression/79-wrpointer/11-array.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include diff --git a/tests/regression/79-wrpointer/12-rel-function.c b/tests/regression/79-wrpointer/12-rel-function.c index 639c6612df..03dd223eda 100644 --- a/tests/regression/79-wrpointer/12-rel-function.c +++ b/tests/regression/79-wrpointer/12-rel-function.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include diff --git a/tests/regression/79-wrpointer/13-experiments.c b/tests/regression/79-wrpointer/13-experiments.c index 2f5f77f160..3420307613 100644 --- a/tests/regression/79-wrpointer/13-experiments.c +++ b/tests/regression/79-wrpointer/13-experiments.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include diff --git a/tests/regression/79-wrpointer/15-arrays-structs.c b/tests/regression/79-wrpointer/15-arrays-structs.c index 6df66d92d2..cbce0fae63 100644 --- a/tests/regression/79-wrpointer/15-arrays-structs.c +++ b/tests/regression/79-wrpointer/15-arrays-structs.c @@ -1,5 +1,5 @@ -// PARAM: --set ana.activated[+] wrpointer +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState #include #include From eaf685677a5cfa614ca24cd3014f56b493536a94 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 25 Apr 2024 14:25:40 +0200 Subject: [PATCH 081/323] removed TODO --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 4b9daa6db2..c34ff561ea 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -550,7 +550,7 @@ module Term(Var:Val) = struct let default_int_type = IInt let to_cil_constant ask z t = let z = Z.(z/ get_element_size_in_bits t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) - (** TODO: Convert a term to a cil expression and its cil type. *) + (** Convert a term to a cil expression and its cil type. *) let rec to_cil ask off t = let cil_t, vtyp = match t with | Addr v -> AddrOf (Var v, NoOffset), TPtr (v.vtype, []) From 0bab9cc04e722cde53278e243c520e53d8adf6bb Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 25 Apr 2024 17:10:06 +0200 Subject: [PATCH 082/323] implemented enter and combine and adapted startState analysis so that it also remembers other variables that are needed in order to implement these functions --- src/analyses/startStateAnalysis.ml | 27 ++++++--- .../weaklyRelationalPointerAnalysis.ml | 56 ++++++++++++------- 2 files changed, 57 insertions(+), 26 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 693d251e64..a1bd5e2b1f 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -2,10 +2,11 @@ Used by the wrpointer anaylysis. *) open GoblintCil +open Batteries open Analyses -(*First all local variables of the function are duplicated (by negating their ID), +(*First all parameters (=formals) of the function are duplicated (by negating their ID), then we remember the value of each local variable at the beginning of the function in this new duplicated variable. *) module Spec : Analyses.MCPSpec = @@ -19,7 +20,9 @@ struct include Analyses.IdentitySpec - let duplicated_variable var = { var with vid = - var.vid } + + let duplicated_variable var = { var with vid = - var.vid; vname = var.vname ^ "'" } + let original_variable var = { var with vid = - var.vid; vname = String.rchop var.vname } let get_value (ask: Queries.ask) exp = ask.f (MayPointTo exp) @@ -31,12 +34,19 @@ struct | Some v -> v | None -> Value.top() end - | AddrOf (Var x, NoOffset) -> get_value ask (AddrOf (Var (duplicated_variable x), NoOffset)) + | AddrOf (Var x, NoOffset) -> if x.vid < 0 then get_value ask (AddrOf (Var (original_variable x), NoOffset)) else Value.top() | _ -> Value.top () let startstate v = D.bot () let exitstate = startstate + let return ctx exp_opt f = + (*remember all value of local vars*) + List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in + if M.tracing then M.trace "startState" "return: added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; + D.add (var) value st) (D.empty()) (f.sformals @ f.slocals) + + let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in match q with @@ -50,11 +60,14 @@ struct let body ctx (f:fundec) = List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in - if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; - D.add var value st) (D.empty()) (List.map duplicated_variable f.sformals) + if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var (duplicated_variable var), NoOffset) Value.pretty value; + D.add (duplicated_variable var) value st) (D.empty()) f.sformals - let combine_env ctx var_opt expr f exprs t_context_opt t ask = - ctx.local + let combine_assign ctx var_opt expr f exprs t_context_opt t ask = + (*remove duplicated vars and local vars *) + List.fold_left (fun st var -> + if M.tracing then M.trace "startState" "removing var: var: %a" d_lval (Var var, NoOffset); + D.remove (var) st) (D.empty()) (f.sformals @ f.slocals @ (List.map duplicated_variable f.sformals)) end diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 89e9241fc8..2eb905f102 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -63,6 +63,12 @@ struct | exception (T.UnsupportedCilExpression _) -> t | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) + let assign_lval_2_ask t (ask1: Queries.ask) (ask2: Queries.ask) lval expr = + let f (type a) (q: a Queries.t) = + let module Result = (val Queries.Result.lattice q) in + Result.meet (ask1.f q) (ask2.f q) in + let (ask: Queries.ask) = {f} in assign_lval t ask lval expr + let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res @@ -99,37 +105,49 @@ struct branch ctx exp true | _, _ -> ctx.local + let duplicated_variable var = { var with vid = - var.vid; vname = var.vname ^ "'" } + let original_variable var = { var with vid = - var.vid; vname = String.rchop var.vname } + + (*First all local variables of the function are duplicated (by negating their ID), + then we remember the value of each local variable at the beginning of the function + by using the analysis startState. This way we can infer the relations between the + local variables of the caller and the pointers that were modified by the function. *) let enter ctx var_opt f args = - (* assign function parameters *) + (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in - let new_state = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var var, NoOffset) exp) ctx.local arg_assigns in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in + if M.tracing then M.trace "wrpointer-function" "ENTER1: state_with_assignments: %s\n" (D.show state_with_assignments); + (* add duplicated variables, and set them equal to the original variables *) + let added_equalities = (List.map (fun v -> (CC.Deref (CC.Addr (duplicated_variable v),Z.zero), CC.Deref (CC.Addr v,Z.zero), Z.zero)) f.sformals) in + let state_with_duplicated_vars = meet_conjs state_with_assignments added_equalities in + if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) - let arg_vars = List.map fst arg_assigns in - let reachable_variables = arg_vars (**@ all globals bzw not_locals*) + let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals (*@ all globals*) in - let new_state = D.remove_terms_not_containing_variables reachable_variables new_state in - if M.tracing then M.trace "wrpointer-function" "ENTER: var_opt: %a; state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show new_state); - [ctx.local, new_state] + let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in + if M.tracing then M.trace "wrpointer-function" "ENTER3: result: %s\n" (D.show new_state); + [state_with_assignments, new_state] (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) let combine_env ctx var_opt expr f exprs t_context_opt t ask = - let local_vars = f.sformals @ f.slocals in + let og_t = t in let t = D.meet ctx.local t in - let res = - D.remove_terms_containing_variables local_vars t - in if M.tracing then M.trace "wrpointer-function" "COMBINE_ENV: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + let t = match var_opt with + | None -> t + | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var Disequalities.dummy_lval + in + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); + let local_vars = f.sformals @ f.slocals in + let duplicated_vars = List.map duplicated_variable f.sformals in + let t = + D.remove_terms_containing_variables (Disequalities.dummy_varinfo::local_vars @ duplicated_vars) t + in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t (*ctx.local is after combine_env, t callee*) let combine_assign ctx var_opt expr f exprs t_context_opt t ask = - let ask = (ask_of_ctx ctx) in - let t' = combine_env ctx var_opt expr f exprs t_context_opt t ask in - let t' = match var_opt with - | None -> t' - | Some var -> assign_lval t' ask var Disequalities.dummy_lval - in - let res = D.remove_terms_containing_variable Disequalities.dummy_var t' - in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN: var_opt: %a; local_state: %s; t_state: %s; result: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show t) (D.show res); res + ctx.local let threadenter ctx ~multiple var_opt v exprs = [ctx.local] let threadspawn ctx ~multiple var_opt v exprs ctx2 = ctx.local From a2010f5b5c78111ee36a3f3b64dc931e8f776552 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 25 Apr 2024 17:10:32 +0200 Subject: [PATCH 083/323] fix bug when detecting cyclic dependencies in the union find --- src/cdomains/congruenceClosure.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c34ff561ea..b7fcea36c4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1017,11 +1017,11 @@ module CongruenceClosure (Var : Val) = struct let rec detect_cyclic_dependencies t1 t2 cc = match t1 with | Addr v -> false - | Deref (t, _) -> + | Deref (t1, _) -> let v1, o1 = TUF.find_no_pc cc.uf t1 in let v2, o2 = TUF.find_no_pc cc.uf t2 in if T.equal v1 v2 then true else - detect_cyclic_dependencies t t2 cc + detect_cyclic_dependencies t1 t2 cc let add_successor_terms cc t = let add_one_successor (cc, successors) (edge_z, _) = From ccae25ebf301f55134e3c362024308ce3f3cf3dd Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 26 Apr 2024 15:25:08 +0200 Subject: [PATCH 084/323] fixed computing overlaps in may_be_equal --- src/cdomains/weaklyRelationalPointerDomain.ml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 0d943e8d92..20868f935d 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -21,7 +21,7 @@ module Disequalities = struct if T.equal t1 t2 then true else (* two local arrays can never point to the same array *) let are_different_arrays = match t1, t2 with - | Deref (Addr x1, z1), Deref (Addr x2, z2) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false + | Deref (Addr x1, z1), Deref (Addr x2, z2) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false | _ -> false in if are_different_arrays || Var.equal dummy_varinfo (T.get_var t1) || Var.equal dummy_varinfo (T.get_var t2) then false else let exp1 = T.to_cil ask Z.zero t1 in @@ -33,17 +33,20 @@ module Disequalities = struct (T.show t1) d_plainexp exp1 AD.pretty mpt1 (T.get_var t1).vid (T.show t2) d_plainexp exp2 AD.pretty mpt2 (T.get_var t2).vid (string_of_bool res); res (**Returns true iff by assigning to t1, the value of t2 could change. *) - let rec may_be_equal ask uf t1 t2 = + let rec may_be_equal ask uf t1 t2 = + let there_is_an_overlap s s' diff = + if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) + in match t1, t2 with | CC.Deref (t, z), CC.Deref (v, z') -> let (q', z1') = TUF.find_no_pc uf v in let (q, z1) = TUF.find_no_pc uf t in - let s = T.get_size_in_bits (T.type_of_term t) in - let s' = T.get_size_in_bits (T.type_of_term v) in + let s = T.get_size_in_bits (T.type_of_term t1) in + let s' = T.get_size_in_bits (T.type_of_term t2) in let diff = Z.(-z' - z1 + z1' + z) in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( - (not (T.equal q' q) || Z.(lt diff s && lt (-s') diff)) + (not (T.equal q' q) || there_is_an_overlap s s' diff) (* or if we know that they are not equal according to the query MayPointTo*) && (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) From 01a4b2dc941af70acba5f698e99d66e01b873a20 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 26 Apr 2024 15:56:28 +0200 Subject: [PATCH 085/323] fixed some problems in the conversion --- src/cdomains/congruenceClosure.ml | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b7fcea36c4..fdc7f9095b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -374,6 +374,15 @@ module Term(Var:Val) = struct | Some i -> i | None -> raise (UnsupportedCilExpression "unknown offset") + (** For a type TPtr(t) it returns the type t. *) + let dereference_type = function + | TPtr (typ, _) -> typ + | typ -> let rec remove_array_and_struct_types = function + | TArray (typ, _, _) -> remove_array_and_struct_types typ + | TComp (cinfo, _) -> raise (UnsupportedCilExpression "not supported yet") (*TODO*) + | typ -> typ + in remove_array_and_struct_types typ + let rec type_of_term = let get_field_at_index z = List.find (fun field -> Z.equal (get_field_offset field) z) @@ -383,14 +392,8 @@ module Term(Var:Val) = struct | TComp (cinfo, _) -> (get_field_at_index z cinfo.cfields).ftype | _ -> x.vtype end - | (Deref (t, z)) -> begin match type_of_term t with - | TPtr (typ, _) -> typ - | typ -> let rec remove_array_and_struct_types = function - | TArray (typ, _, _) -> remove_array_and_struct_types typ - | TComp (cinfo, _) -> raise (UnsupportedCilExpression "not supported yet") (*TODO*) - | typ -> typ - in remove_array_and_struct_types typ - end + | (Deref (t, z)) -> dereference_type (type_of_term t) + let rec of_index ask t var_type curr_offs = @@ -457,9 +460,7 @@ module Term(Var:Val) = struct end | _ -> raise (UnsupportedCilExpression "unsupported BinOp") end - | CastE (typ, exp)-> let old_size = get_element_size_in_bits (Cilfacade.typeOf exp) in - let new_size = get_element_size_in_bits (Cilfacade.typeOf e) in - let t, off = of_cil ask exp in t, Z.(off * new_size / old_size) + | CastE (typ, exp)-> of_cil ask exp | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") and of_lval ask lval = let res = match lval with | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) var.vtype off Z.zero @@ -471,7 +472,7 @@ module Term(Var:Val) = struct let typ = Cilfacade.typeOf exp in if is_struct_ptr_type typ then of_offset ask term typ off offset else - of_offset ask (Deref (term, offset)) typ off Z.zero + of_offset ask (Deref (term, offset)) (Cilfacade.typeOfLval (Mem exp, NoOffset)) off Z.zero | _ -> raise (UnsupportedCilExpression "cannot dereference constant") end in (if M.tracing then match res with From dae84a72d9a64619437ade2521a8fc078bcd7668 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Apr 2024 12:41:19 +0200 Subject: [PATCH 086/323] small improvement in converting to cil --- src/cdomains/congruenceClosure.ml | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index fdc7f9095b..988d8e529d 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -347,7 +347,9 @@ module Term(Var:Val) = struct | i -> Some i | exception (UnsupportedCilExpression _) -> None - let rec get_size_in_bits typ = Z.of_int (bitsSizeOf typ) + let rec get_size_in_bits typ = match typ with + | TArray (typ, _, _) -> get_size_in_bits (TPtr (typ,[])) + | _ -> Z.of_int (bitsSizeOf typ) (**Returns the size of the type. If typ is a pointer, it returns the size of the elements it points to. If typ is an array, it returns the ize of the @@ -397,15 +399,21 @@ module Term(Var:Val) = struct let rec of_index ask t var_type curr_offs = + let rec type_array = function + | TArray (arr_type, _, _) -> arr_type + | _ -> raise (UnsupportedCilExpression "incoherent type of variable") in let rec type_len_array ask = function | TArray (arr_type, Some exp, _) -> arr_type, eval_int ask exp | _ -> raise (UnsupportedCilExpression "incoherent type of variable") in function | Index (exp, NoOffset) -> - let new_var_type, len_array = type_len_array ask var_type in + let new_var_type = type_array var_type in let var_size = get_element_size_in_bits new_var_type in let z' = Z.(eval_int ask exp * var_size) in - t, Z.(curr_offs * len_array + z'), new_var_type + if Z.(equal curr_offs zero) then t, Z.(z'), new_var_type + else + let new_var_type, len_array = type_len_array ask var_type in + t, Z.(curr_offs * len_array + z'), new_var_type | Index (exp, off) -> let new_var_type, len_array = type_len_array ask var_type in let var_size = get_element_size_in_bits new_var_type in From f22f4f30e6ac1712b0abf28e12e0393c27d4f127 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Apr 2024 14:29:36 +0200 Subject: [PATCH 087/323] modified a comment --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 988d8e529d..70326bf56c 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -353,7 +353,7 @@ module Term(Var:Val) = struct (**Returns the size of the type. If typ is a pointer, it returns the size of the elements it points to. If typ is an array, it returns the ize of the - elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int[][][] = sizeof(int)). *) + elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int\[]\[]\[] = sizeof(int)). *) let rec get_element_size_in_bits typ = match typ with | TArray (typ, _, _) -> get_element_size_in_bits typ From 69b00313b384f2179d4f7bc84a8b063119dfeb14 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Apr 2024 17:14:06 +0200 Subject: [PATCH 088/323] minor style choices --- src/analyses/weaklyRelationalPointerAnalysis.ml | 6 +++--- src/cdomains/congruenceClosure.ml | 1 + src/cdomains/weaklyRelationalPointerDomain.ml | 6 +++--- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 2eb905f102..933f112ea9 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -86,7 +86,7 @@ struct let assign_return ask t return_var expr = (* the return value is not stored on the heap, therefore we don't need to remove any terms *) match T.of_cil ask expr with - | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] (insert_set_opt t (SSet.TSet.of_list [return_var; term])) + | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] t | _ -> t let return ctx exp_opt f = @@ -118,8 +118,8 @@ struct let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in if M.tracing then M.trace "wrpointer-function" "ENTER1: state_with_assignments: %s\n" (D.show state_with_assignments); (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = (List.map (fun v -> (CC.Deref (CC.Addr (duplicated_variable v),Z.zero), CC.Deref (CC.Addr v,Z.zero), Z.zero)) f.sformals) in - let state_with_duplicated_vars = meet_conjs state_with_assignments added_equalities in + let added_equalities = (List.map (fun v -> CC.Equal (CC.Deref (CC.Addr (duplicated_variable v),Z.zero), CC.Deref (CC.Addr v,Z.zero), Z.zero)) f.sformals) in + let state_with_duplicated_vars = meet_conjs_opt added_equalities state_with_assignments in if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals (*@ all globals*) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 70326bf56c..24b8b214d0 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -510,6 +510,7 @@ module Term(Var:Val) = struct let of_cil ask e = of_cil_neg ask false e let map_z_opt op z = Tuple2.map2 (Option.map (op z)) + (** Converts a cil expression e = "t1 + off1 - (t2 + off2)" to two terms (Some t1, Some off1), (Some t2, Some off2)*) let rec two_terms_of_cil ask neg e = let pos_t, neg_t = match e with diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 20868f935d..abf0fe2978 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -10,7 +10,7 @@ module M = Messages (**Find out if two addresses are not equal by using the MayPointTo query*) module Disequalities = struct - module AD = AddressDomain.AddressSet (PreValueDomain.Mval) (ValueDomain.ID) + module AD = ValueDomain.AD let dummy_varinfo = dummyFunDec.svar let dummy_var = CC.Addr dummy_varinfo @@ -29,8 +29,8 @@ module Disequalities = struct let mpt1 = ask.f (MayPointTo exp1) in let mpt2 = ask.f (MayPointTo exp2) in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; exp1: %a; res: %a; var1: %d;\nt2: %s; exp2: %a; res: %a; var2: %d;\nresult: %s\n" - (T.show t1) d_plainexp exp1 AD.pretty mpt1 (T.get_var t1).vid (T.show t2) d_plainexp exp2 AD.pretty mpt2 (T.get_var t2).vid (string_of_bool res); res + if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; exp1: %a; res: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + (T.show t1) d_plainexp exp1 AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res (**Returns true iff by assigning to t1, the value of t2 could change. *) let rec may_be_equal ask uf t1 t2 = From 69dc1ff7cd9eb4bde6ff1395af1d1703832c55b4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 1 May 2024 13:14:46 +0200 Subject: [PATCH 089/323] simplify cil conversion by using to_index --- src/cdomains/congruenceClosure.ml | 88 ++++++++++++++----------------- 1 file changed, 41 insertions(+), 47 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 24b8b214d0..7a2ff8dde0 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -372,7 +372,28 @@ module Term(Var:Val) = struct | TPtr(TComp _,_) -> true | _ -> false - let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with + + let cil_offs_to_idx (ask: Queries.ask) offs typ = + (* TODO: Some duplication with convert_offset in base.ml and cil_offs_to_idx in memOutOfBounds.ml, + unclear how to immediately get more reuse *) + let rec convert_offset (ofs: offset) = + match ofs with + | NoOffset -> `NoOffset + | Field (fld, ofs) -> `Field (fld, convert_offset ofs) + | Index (exp, ofs) when CilType.Exp.equal exp (Lazy.force Offset.Index.Exp.any) -> (* special offset added by convertToQueryLval *) + `Index (ValueDomain.ID.top (), convert_offset ofs) + | Index (exp, ofs) -> + let i = match ask.f (Queries.EvalInt exp) with + | `Lifted x -> IntDomain.IntDomTuple.cast_to (Cilfacade.ptrdiff_ikind ()) @@ x + | _ -> ValueDomain.ID.top_of @@ Cilfacade.ptrdiff_ikind () + in + `Index (i, convert_offset ofs) + in + PreValueDomain.Offs.to_index ?typ:(Some typ) (convert_offset offs) + + + let z_of_offset ask offs typ = + match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i | None -> raise (UnsupportedCilExpression "unknown offset") @@ -385,51 +406,21 @@ module Term(Var:Val) = struct | typ -> typ in remove_array_and_struct_types typ - let rec type_of_term = - let get_field_at_index z = - List.find (fun field -> Z.equal (get_field_offset field) z) + let rec type_of_term ask = + let get_field_at_index z typ = + List.find (fun field -> Z.equal (z_of_offset ask (Field (field, NoOffset)) typ) z) in function | (Addr x) -> TPtr (x.vtype,[]) - | (Deref (Addr x, z)) -> begin match x.vtype with - | TComp (cinfo, _) -> (get_field_at_index z cinfo.cfields).ftype + | (Deref (Addr x, z)) -> begin match x.vtype with (*TODO this doesnt work for arrays of arrays of structs ecc*) + | TComp (cinfo, _) -> (get_field_at_index z x.vtype cinfo.cfields).ftype | _ -> x.vtype end - | (Deref (t, z)) -> dereference_type (type_of_term t) - - - - let rec of_index ask t var_type curr_offs = - let rec type_array = function - | TArray (arr_type, _, _) -> arr_type - | _ -> raise (UnsupportedCilExpression "incoherent type of variable") in - let rec type_len_array ask = function - | TArray (arr_type, Some exp, _) -> arr_type, eval_int ask exp - | _ -> raise (UnsupportedCilExpression "incoherent type of variable") in - function - | Index (exp, NoOffset) -> - let new_var_type = type_array var_type in - let var_size = get_element_size_in_bits new_var_type in - let z' = Z.(eval_int ask exp * var_size) in - if Z.(equal curr_offs zero) then t, Z.(z'), new_var_type - else - let new_var_type, len_array = type_len_array ask var_type in - t, Z.(curr_offs * len_array + z'), new_var_type - | Index (exp, off) -> - let new_var_type, len_array = type_len_array ask var_type in - let var_size = get_element_size_in_bits new_var_type in - let z' = Z.(eval_int ask exp * var_size) in - let t, z'', new_var_type = of_index ask t new_var_type Z.(curr_offs * len_array + z') off in - t, z'', new_var_type - | Field (finfo, off) -> let field_offset = get_field_offset finfo in - let t, z'', new_var_type = of_index ask t finfo.ftype Z.zero off in - t, Z.(curr_offs + field_offset + z''), new_var_type - | NoOffset -> t, curr_offs, var_type - - let rec of_offset ask t var_type off initial_offs = - if off == NoOffset then t else - let t, z, var_type = of_index ask t var_type initial_offs off in - if not (is_array_type var_type) then Deref (t, z) - else raise (UnsupportedCilExpression "this is an address") + | (Deref (t, z)) -> dereference_type (type_of_term ask t) + + let rec of_offset ask t off typ = + if off = NoOffset then t else + let z = z_of_offset ask off typ in + Deref (t, z) (** Converts a cil expression to Some term, Some offset; or None, Some offset is the expression equals an integer, @@ -471,16 +462,18 @@ module Term(Var:Val) = struct | CastE (typ, exp)-> of_cil ask exp | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") and of_lval ask lval = let res = match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) var.vtype off Z.zero - else - of_offset ask (Deref (Addr var, Z.zero)) var.vtype off Z.zero + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype + else of_offset ask (Deref (Addr var, Z.zero)) off var.vtype | (Mem exp, off) -> begin match of_cil ask exp with | (Some term, offset) -> let typ = Cilfacade.typeOf exp in - if is_struct_ptr_type typ then of_offset ask term typ off offset + if is_struct_ptr_type typ then + match of_offset ask term off typ with + | Addr x -> Addr x + | Deref (x, z) -> Deref (x, Z.(z+offset)) else - of_offset ask (Deref (term, offset)) (Cilfacade.typeOfLval (Mem exp, NoOffset)) off Z.zero + of_offset ask (Deref (term, offset)) off typ | _ -> raise (UnsupportedCilExpression "cannot dereference constant") end in (if M.tracing then match res with @@ -505,6 +498,7 @@ module Term(Var:Val) = struct in (if M.tracing && not neg then match res with | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show_v t) (Z.to_string z) + | None, None -> () | _ -> M.trace "wrpointer-cil-conversion" "This is impossible. exp: %a\n" d_plainexp e); res let of_cil ask e = of_cil_neg ask false e From 72d689e300c77eb746dc64b83380c1f36b99aa98 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 1 May 2024 13:40:36 +0200 Subject: [PATCH 090/323] fix small thing --- src/cdomains/weaklyRelationalPointerDomain.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index abf0fe2978..a97121b441 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -41,8 +41,8 @@ module Disequalities = struct | CC.Deref (t, z), CC.Deref (v, z') -> let (q', z1') = TUF.find_no_pc uf v in let (q, z1) = TUF.find_no_pc uf t in - let s = T.get_size_in_bits (T.type_of_term t1) in - let s' = T.get_size_in_bits (T.type_of_term t2) in + let s = T.get_size_in_bits (T.type_of_term ask t1) in + let s' = T.get_size_in_bits (T.type_of_term ask t2) in let diff = Z.(-z' - z1 + z1' + z) in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( From 70c273fb36a0ceb8e501bfd6c1f6278ebaf6330f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 1 May 2024 13:43:27 +0200 Subject: [PATCH 091/323] removed code for invertible assignments, as it is not necessary --- src/cdomains/congruenceClosure.ml | 67 ------------------- src/cdomains/weaklyRelationalPointerDomain.ml | 27 -------- 2 files changed, 94 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7a2ff8dde0..4632d5c00a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1182,71 +1182,4 @@ module CongruenceClosure (Var : Val) = struct (show_all old_cc) (show_all {uf; set; map; min_repr}); {uf; set; map; min_repr} - - (* invertible assignments *) - - let shift_uf uf map t z off map_of_children = - let t', k1, uf = TUF.find uf t in - match LMap.map_find_opt_set (t', Z.(z-k1)) map with - | None -> uf - | Some to_be_shifted -> - let shift_element el uf = - (* modify parent offset *) - let uf = if TUF.is_root uf el then uf else - TUF.modify_offset uf el (fun o -> Z.(o - off)) in - (* modify children offset *) - let children = TMap.find el map_of_children in - List.fold_left (fun uf child -> TUF.modify_offset uf child (Z.(+) off)) uf children - in - SSet.fold shift_element to_be_shifted uf - - let shift_subterm uf map set t z off map_of_children = - let t', k1, uf = TUF.find uf t in - match LMap.map_find_opt_set (t', Z.(z-k1)) map with - | None -> uf, set, map - | Some to_be_shifted -> - let rec modify_subterm v = match v with - | Addr _ -> v - | Deref (v', z) -> let z' = if SSet.mem v' to_be_shifted then Z.(z + off) else z in - Deref (modify_subterm v', z') in - let shift_element el (uf, set, map) = - let new_el = modify_subterm el in - (* modify mapping in union find *) - let parent = TUF.ValMap.find el uf in - let uf = TUF.ValMap.add new_el parent (TUF.ValMap.remove el uf) in - (* modify children *) - let children = TMap.find el map_of_children in - let uf = List.fold_left (fun uf child -> TUF.modify_parent uf child (new_el, TUF.parent_offset uf child)) uf children in - (* modify map *) - let map = match LMap.find_opt el map with - | None -> map - | Some entry -> LMap.add new_el entry (LMap.remove el map) - in (uf, SSet.add new_el set, map) - in - let uf, set, map = SSet.fold shift_element to_be_shifted (uf, set, map) - in uf, set, LMap.map_values map modify_subterm - - - (** Remove terms from the data structure. - It removes all terms for which "predicate" is false, - while maintaining all equalities about variables that are not being removed. - Then it shifts all occurences of subterms ∗(z′ + v) where z' + v = z + t - and replaces it with the subterm off+∗(z′+v). *) - let remove_terms_and_shift predicate cc t z off = - (* first find all terms that need to be removed *) - let set, removed_terms, map_of_children, cc = - remove_terms_from_set cc predicate - in let uf, new_parents_map, map_of_children = - remove_terms_from_uf cc.uf removed_terms map_of_children predicate - in let map = - remove_terms_from_mapped_values cc.map (predicate cc.uf) - in let map, uf = - remove_terms_from_map (uf, map) removed_terms new_parents_map - in let uf = shift_uf uf cc.map t z off map_of_children - in let uf,set,map = shift_subterm uf cc.map set t z off map_of_children - in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS AND SHIFT: %s\n RESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all {uf; set; map; min_repr}); - {uf; set; map; min_repr} - end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index a97121b441..b98961a597 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -59,24 +59,6 @@ module Disequalities = struct let res = (may_be_equal ask uf t1 t2) in if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res - - (**Returns true iff by assigning to t1, the value of t2 could change. - But if we know that t1 and t2 are definitely equal, then it returns false. *) - let rec may_be_equal_but_not_definitely_equal ask uf t1 t2 = - match t1, t2 with - | CC.Deref (t, z), CC.Deref (v, z') -> - let (q', z1') = TUF.find_no_pc uf v in - let (q, z1) = TUF.find_no_pc uf t in - (* If they are in the same equivalence class, then we return false *) - ( - (not (T.equal q' q)) - (* or if we know that they are not equal according to the query MayPointTo*) - && - (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) - ) - || (may_be_equal ask uf t1 v) - | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) - | CC.Addr _ , _ -> T.is_subterm t1 t2 end module D = struct @@ -170,13 +152,4 @@ module D = struct let cc = Option.map (fun cc -> (snd(insert cc term))) cc in Option.map (remove_terms (fun uf -> Disequalities.may_be_equal ask uf term)) cc - (** Remove terms from the data structure and shifts other terms. - It removes all terms that may be changed after an assignment to "term". - It shifts all elements that were modified by the asignmnt to "term". *) - let remove_and_shift_may_equal_terms ask cc t z off = - let term = CC.Deref (t, z) in - if M.tracing then M.trace "wrpointer" "remove_and_shift_may_equal_terms: %s. Off: %s\n" (T.show term) (Z.to_string off); - let cc = Option.map (fun cc -> (snd(insert cc term))) cc in - Option.map (fun cc -> remove_terms_and_shift (fun uf -> Disequalities.may_be_equal_but_not_definitely_equal ask uf term) cc t z off) cc - end From 31ae30dbfe6f8ed8dbef9befa4b88bd252c73af5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 1 May 2024 14:07:00 +0200 Subject: [PATCH 092/323] add size parameter to may_be_equal for the ize of the lvalue --- .../weaklyRelationalPointerAnalysis.ml | 24 +++++++++-------- src/cdomains/weaklyRelationalPointerDomain.ml | 27 ++++++++++--------- 2 files changed, 27 insertions(+), 24 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 933f112ea9..e1b4f69f59 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -49,16 +49,18 @@ struct | _ -> Result.top q let assign_lval t ask lval expr = + let s = T.get_element_size_in_bits (typeOfLval lval) in match T.of_lval ask lval, T.of_cil ask expr with (* Indefinite assignment *) - | lterm, (None, _) -> D.remove_may_equal_terms ask lterm t + | lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t (* Definite assignment *) | lterm, (Some term, Some offset) -> + let dummy_var = Disequalities.dummy_var (typeOfLval lval) in if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s\n" (T.show lterm) (T.show term) (Z.to_string offset); - t |> meet_conjs_opt [Equal (Disequalities.dummy_var, term, offset)] |> - D.remove_may_equal_terms ask lterm |> - meet_conjs_opt [Equal (lterm, Disequalities.dummy_var, Z.zero)] |> - D.remove_terms_containing_variable Disequalities.dummy_var + t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> + D.remove_may_equal_terms ask s lterm |> + meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> + D.remove_terms_containing_variable dummy_var (* invertibe assignment *) | exception (T.UnsupportedCilExpression _) -> t | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) @@ -92,9 +94,9 @@ struct let return ctx exp_opt f = let res = match exp_opt with | Some e -> - assign_return (ask_of_ctx ctx) ctx.local Disequalities.dummy_var e + assign_return (ask_of_ctx ctx) ctx.local (Disequalities.dummy_var (typeOf e)) e | None -> ctx.local - in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Disequalities.dummy_lval) exp_opt) (D.show ctx.local) (D.show res);res + in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Disequalities.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in @@ -120,7 +122,7 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = (List.map (fun v -> CC.Equal (CC.Deref (CC.Addr (duplicated_variable v),Z.zero), CC.Deref (CC.Addr v,Z.zero), Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities state_with_assignments in - if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Disequalities.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals (*@ all globals*) in @@ -133,16 +135,16 @@ struct let combine_env ctx var_opt expr f exprs t_context_opt t ask = let og_t = t in let t = D.meet ctx.local t in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var Disequalities.dummy_varinfo, NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (Disequalities.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t - | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var Disequalities.dummy_lval + | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var (Disequalities.dummy_lval (typeOfLval var)) in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in let t = - D.remove_terms_containing_variables (Disequalities.dummy_varinfo::local_vars @ duplicated_vars) t + D.remove_terms_containing_variables (Disequalities.dummy_varinfo (TVoid [])::local_vars @ duplicated_vars) t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t (*ctx.local is after combine_env, t callee*) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index b98961a597..b1efafa8a8 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -12,18 +12,19 @@ module Disequalities = struct module AD = ValueDomain.AD - let dummy_varinfo = dummyFunDec.svar - let dummy_var = CC.Addr dummy_varinfo - let dummy_lval = AddrOf (Var dummy_varinfo, NoOffset) + let dummy_varinfo typ = {dummyFunDec.svar with vtype=typ} + let dummy_var var = CC.Addr (dummy_varinfo var) + let dummy_lval var = AddrOf (Var (dummy_varinfo var), NoOffset) - (**Find out if two addresses are possibly equal by using the MayPointTo query*) + (**Find out if two addresses are possibly equal by using the MayPointTo query. + The parameter s is the size (in bits) of the value that t1 points to. *) let may_point_to_same_address (ask:Queries.ask) t1 t2 off = if T.equal t1 t2 then true else (* two local arrays can never point to the same array *) let are_different_arrays = match t1, t2 with | Deref (Addr x1, z1), Deref (Addr x2, z2) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false | _ -> false in - if are_different_arrays || Var.equal dummy_varinfo (T.get_var t1) || Var.equal dummy_varinfo (T.get_var t2) then false else + if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term ask t1)) (T.get_var t1) || Var.equal (dummy_varinfo (T.type_of_term ask t2)) (T.get_var t2) then false else let exp1 = T.to_cil ask Z.zero t1 in let exp2 = T.to_cil ask off t2 in let mpt1 = ask.f (MayPointTo exp1) in @@ -32,8 +33,9 @@ module Disequalities = struct if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; exp1: %a; res: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" (T.show t1) d_plainexp exp1 AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res - (**Returns true iff by assigning to t1, the value of t2 could change. *) - let rec may_be_equal ask uf t1 t2 = + (**Returns true iff by assigning to t1, the value of t2 could change. + The parameter s is the size in bits of the variable t1 we are assigning to. *) + let rec may_be_equal ask uf s t1 t2 = let there_is_an_overlap s s' diff = if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) in @@ -41,7 +43,6 @@ module Disequalities = struct | CC.Deref (t, z), CC.Deref (v, z') -> let (q', z1') = TUF.find_no_pc uf v in let (q, z1) = TUF.find_no_pc uf t in - let s = T.get_size_in_bits (T.type_of_term ask t1) in let s' = T.get_size_in_bits (T.type_of_term ask t2) in let diff = Z.(-z' - z1 + z1' + z) in (* If they are in the same equivalence class but with a different offset, then they are not equal *) @@ -51,12 +52,12 @@ module Disequalities = struct && (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) ) - || (may_be_equal ask uf t1 v) + || (may_be_equal ask uf s t1 v) | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) | CC.Addr _ , _ -> T.is_subterm t1 t2 - let may_be_equal ask uf t1 t2 = - let res = (may_be_equal ask uf t1 t2) in + let may_be_equal ask uf s t1 t2 = + let res = (may_be_equal ask uf s t1 t2) in if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res end @@ -147,9 +148,9 @@ module D = struct (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) - let remove_may_equal_terms ask term cc = + let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = Option.map (fun cc -> (snd(insert cc term))) cc in - Option.map (remove_terms (fun uf -> Disequalities.may_be_equal ask uf term)) cc + Option.map (remove_terms (fun uf -> Disequalities.may_be_equal ask uf s term)) cc end From 8b427c4cd1aa02042b5cf4cc69832ab4f04655b9 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 1 May 2024 14:28:43 +0200 Subject: [PATCH 093/323] changed Congruence closure to not be generic, but only work for for varinfo --- .../weaklyRelationalPointerAnalysis.ml | 2 +- src/cdomains/congruenceClosure.ml | 579 +++++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 3 files changed, 282 insertions(+), 301 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index e1b4f69f59..7beaf71e6c 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -6,7 +6,7 @@ open Analyses open GoblintCil open WeaklyRelationalPointerDomain module CC = CongruenceClosure -open CC.CongruenceClosure(Var) +open CC.CongruenceClosure open Batteries module Spec = diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 4632d5c00a..f08be51b50 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -2,293 +2,15 @@ open Batteries open GoblintCil +module Var = CilType.Varinfo module M = Messages -module type Val = sig - type t - val compare : t -> t -> int - val equal : t -> t -> bool - val show : t -> string - val hash : t -> int -end - -module ValMap(Val:Val) = struct - include Map.Make(Val) - let hash node_hash y = fold (fun x node acc -> acc + Val.hash x + node_hash node) y 0 -end - -module ValSet(Val:Val) = struct - include Set.Make(Val) - let hash x = fold (fun x y -> y + Val.hash x) x 0 -end - -(** Quantitative union find *) -module UnionFind (Val: Val) = struct - module ValMap = ValMap(Val) - - (** (value * offset) ref * size of equivalence class *) - type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] - - type t = Val.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) - - exception UnknownValue of Val.t - exception InvalidUnionFind of string - - let empty = ValMap.empty - - (** create empty union find map, given a list of elements *) - let init = List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) - - (** `parent uf v` returns (p, z) where p is the parent element of - v in the union find tree and z is the offset. - - Throws "Unknown value" if v is not present in the data structure.*) - let parent uf v = match fst (ValMap.find v uf) with - | exception Not_found -> raise (UnknownValue v) - | x -> x - - (** `parent_opt uf v` returns Some (p, z) where p is the parent element of - v in the union find tree and z is the offset. - It returns None if v is not present in the data structure. *) - let parent_opt uf v = Option.map (fun _ -> parent uf v) (ValMap.find_opt v uf) - - let parent_term uf v = fst (parent uf v) - let parent_offset uf v = snd (parent uf v) - let subtree_size uf v = snd (ValMap.find v uf) - - (** Modifies the size of the equivalence class for the current element and - for the whole path to the root of this element. - - The third parameter `modification` is the function to apply to the sizes. *) - let rec modify_size t uf modification = - let (p, old_size) = ValMap.find t uf in - let uf = ValMap.add t (p, modification old_size) uf in - let parent = fst p in - if Val.equal parent t then uf else modify_size parent uf modification - - let modify_parent uf v (t, offset) = - let (_, size) = ValMap.find v uf in - ValMap.add v ((t, offset), size) uf - - let modify_offset uf v modification = - let ((t, offset), size) = ValMap.find v uf in - ValMap.add v ((t, modification offset), size) uf - - (** Returns true if each equivalence class in the data structure contains only one element, - i.e. every node is a root. *) - let is_empty uf = List.for_all (fun (v, (t, _)) -> Val.equal v (fst t)) (ValMap.bindings uf) - - (** Returns true if v is the representative value of its equivalence class. - - Throws "Unknown value" if v is not present in the data structure. *) - let is_root uf v = let (parent_t, _) = parent uf v in Val.equal v parent_t - - (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements - grouped by equivalence classes, while this function just prints them in any order. - - Throws "Unknown value" if v is not present in the data structure. *) - let show_uf_ugly uf = - List.fold_left (fun s (v, (refv, size)) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Val.show v ^ - "; Parent: " ^ Val.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") - "" (ValMap.bindings uf) ^ "\n" - - (** - For a variable t it returns the reference variable v and the offset r. - This find performs path compression. - It returns als the updated union-find tree after the path compression. - - Throws "Unknown value" if t is not present in the data structure. - Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. - *) - let find uf v = - let (v',r') = parent uf v in - if Val.equal v' v then - (* v is a root *) - if Z.equal r' Z.zero then v',r', uf - else raise (InvalidUnionFind "non-zero self-distance!") - else if is_root uf v' then - (* the parent of v is a root *) - v',r', uf - else - let rec search v list = - let (v',r') = parent uf v in - if is_root uf v' then - (* perform path compresion *) - let (_,uf) = List.fold_left (fun (r0, uf) v -> - let (parent_v, r''), size_v = ValMap.find v uf in - let uf = modify_parent uf v (v',Z.(r0+r'')) in - let uf = modify_size parent_v uf (fun s -> s - size_v) in - let uf = modify_size v' uf ((+) size_v) - in Z.(r0+r''),uf) (Z.zero, uf) (v::list) - in v',r',uf - else search v' (v :: list) - in search v' [v] - - (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) - let find_opt uf v = match find uf v with - | exception (UnknownValue _) - | exception Not_found - | exception (InvalidUnionFind _) -> None - | res -> Some res - - (** - For a variable t it returns the reference variable v and the offset r. - This find DOES NOT perform path compression. - - Throws "Unknown value" if t is not present in the data structure. - Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. - *) - let rec find_no_pc uf v = - let (v',r') = parent uf v in - if Val.equal v' v then - if Z.equal r' Z.zero then (v',r') - else raise (InvalidUnionFind "non-zero self-distance!") - else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) - - let compare_repr = Tuple2.compare ~cmp1:Val.compare ~cmp2:Z.compare - - (** Compare only first element of the tuples (= the parent term). - It ignores the offset. *) - let compare_repr_v (v1, _) (v2, _) = Val.compare v1 v2 - - (** - Parameters: uf v1 v2 r - - changes the union find data structure `uf` such that the equivalence classes of `v1` and `v2` are merged and `v1 = v2 + r` - - returns v,uf,b where - - - `v` is the new reference variable of the merged equivalence class. It is either the old reference variable of v1 or of v2, depending on which equivalence class is bigger. - - - `uf` is the new union find data structure - - - `b` is true iff v = find v1 - - *) - let union uf v'1 v'2 r = - let v1,r1,uf = find uf v'1 in - let v2,r2,uf = find uf v'2 in - if Val.equal v1 v2 then - if Z.(equal r1 (r2 + r)) then v1, uf, true - else raise (Failure "incomparable union") - else let (_,s1), (_,s2) = ValMap.find v1 uf, ValMap.find v2 uf in - if s1 <= s2 then ( - v2, modify_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false - ) else ( - v1, modify_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true - ) - - (** Returns a list of equivalence classes. *) - let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) - - (** Throws "Unknown value" if the data structure is invalid. *) - let show_uf uf = List.fold_left (fun s eq_class -> - s ^ List.fold_left (fun s (v, (t, size)) -> - s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^Val.show v ^ "; P: " ^ Val.show (fst t) ^ - "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class - ^ "----\n") "" (get_eq_classes uf) ^ "\n" - -end - -(** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a set containing - all terms in the data structure that are equal to *(z + t').*) -module LookupMap (T: Val) = struct - module TMap = ValMap(T) - module TSet = ValSet(T) - - module ZMap = struct - include Map.Make(Z) - let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 - end - - type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] - - let bindings = TMap.bindings - let add = TMap.add - let remove = TMap.remove - let empty = TMap.empty - let find_opt = TMap.find_opt - let find = TMap.find - - let zmap_bindings = ZMap.bindings - (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). *) - let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) - let zmap_find_opt = ZMap.find_opt - let set_any = TSet.any - - (** Merges the set "m" with the set that is already present in the data structure. *) - let zmap_add x y m = match zmap_find_opt x m with - | None -> ZMap.add x y m - | Some set -> ZMap.add x (TSet.union y set) m - - (** Returns the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt_set (v,r) map = match find_opt v map with - | None -> None - | Some zmap -> (match zmap_find_opt r zmap with - | None -> None - | Some v -> Some v - ) - - (** Returns one element of the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt (v,r) map = Option.map TSet.any (map_find_opt_set (v,r) map) - - (** Adds the term "v'" to the set that is already present in the data structure. *) - let map_add (v,r) v' map = let zmap = match find_opt v map with - | None -> ZMap.empty - | Some zmap ->zmap - in add v (zmap_add r (TSet.singleton v') zmap) map - - let show_map map = - List.fold_left - (fun s (v, zmap) -> - s ^ T.show v ^ "\t:\n" ^ - List.fold_left - (fun s (r, v) -> - s ^ "\t" ^ Z.to_string r ^ ": " ^ List.fold_left - (fun s k -> s ^ T.show k ^ ";") - "" (TSet.elements v) ^ ";; ") - "" (zmap_bindings zmap) ^ "\n") - "" (bindings map) - - let print_map = print_string % show_map - - (** The value at v' is shifted by r and then added for v. - The old entry for v' is removed. *) - let shift v r v' map = - match find_opt v' map with - | None -> map - | Some zmap -> let infl = zmap_bindings zmap in - let zmap = List.fold_left (fun zmap (r', v') -> - zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in - remove v' (add v zmap map) - - (** Find all outgoing edges of v in the automata.*) - let successors v map = - match find_opt v map with - | None -> [] - | Some zmap -> zmap_bindings_one_successor zmap - - (** Filters elements from the mapped values which fulfil the predicate p. *) - let filter_if map p = - TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ t_set -> let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) zmap - in if ZMap.is_empty zmap then None else Some zmap) map - - (** Maps elements from the mapped values by applying the function f to them. *) - let map_values map f = - TMap.map (fun zmap -> - ZMap.map (fun t_set -> TSet.map f t_set) zmap) map -end - exception Unsat type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] type 'v prop = Equal of 'v term * 'v term * Z.t | Nequal of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] -module Term(Var:Val) = struct +module Term = struct type t = Var.t term [@@deriving eq, ord, hash] type v_prop = Var.t prop [@@deriving eq, ord, hash] @@ -300,12 +22,6 @@ module Term(Var:Val) = struct | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" - let rec show_v = function - | Addr v -> "&" ^ v.vname - | Deref (Addr v, z) when Z.equal z Z.zero -> v.vname - | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show_v t - | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show_v t ^ ")" - (** Returns true if the first parameter is a subterm of the second one. *) let rec is_subterm st term = equal st term || match term with | Deref (t, _) -> is_subterm st t @@ -478,7 +194,7 @@ module Term(Var:Val) = struct end in (if M.tracing then match res with | exception (UnsupportedCilExpression s) -> M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s - | t -> M.trace "wrpointer-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show_v t)) + | t -> M.trace "wrpointer-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show t)) ;res (** Converts the negated expresion to a term if neg = true. @@ -497,7 +213,7 @@ module Term(Var:Val) = struct | t, z -> t, Some z in (if M.tracing && not neg then match res with | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) - | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show_v t) (Z.to_string z) + | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z) | None, None -> () | _ -> M.trace "wrpointer-cil-conversion" "This is impossible. exp: %a\n" d_plainexp e); res @@ -582,21 +298,290 @@ module Term(Var:Val) = struct (** Convert a term to a cil expression. *) let to_cil ask off t = let exp, typ = to_cil ask off t in if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Offset: %s; Exp: %a; Typ: %a\n" - (show_v t) (Z.to_string off) d_plainexp exp d_plaintype typ; + (show t) (Z.to_string off) d_plainexp exp d_plaintype typ; exp end +module TMap = struct + include Map.Make(Term) + let hash node_hash y = fold (fun x node acc -> acc + Term.hash x + node_hash node) y 0 +end + +module TSet = struct + include Set.Make(Term) + let hash x = fold (fun x y -> y + Term.hash x) x 0 +end + +(** Quantitative union find *) +module UnionFind = struct + module ValMap = TMap + + (** (value * offset) ref * size of equivalence class *) + type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] + + type t = Term.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) + + exception UnknownValue of Term.t + exception InvalidUnionFind of string + + let empty = ValMap.empty + + (** create empty union find map, given a list of elements *) + let init = List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) + + (** `parent uf v` returns (p, z) where p is the parent element of + v in the union find tree and z is the offset. + + Throws "Unknown value" if v is not present in the data structure.*) + let parent uf v = match fst (ValMap.find v uf) with + | exception Not_found -> raise (UnknownValue v) + | x -> x + + (** `parent_opt uf v` returns Some (p, z) where p is the parent element of + v in the union find tree and z is the offset. + It returns None if v is not present in the data structure. *) + let parent_opt uf v = Option.map (fun _ -> parent uf v) (ValMap.find_opt v uf) + + let parent_term uf v = fst (parent uf v) + let parent_offset uf v = snd (parent uf v) + let subtree_size uf v = snd (ValMap.find v uf) + + (** Modifies the size of the equivalence class for the current element and + for the whole path to the root of this element. + + The third parameter `modification` is the function to apply to the sizes. *) + let rec modify_size t uf modification = + let (p, old_size) = ValMap.find t uf in + let uf = ValMap.add t (p, modification old_size) uf in + let parent = fst p in + if Term.equal parent t then uf else modify_size parent uf modification + + let modify_parent uf v (t, offset) = + let (_, size) = ValMap.find v uf in + ValMap.add v ((t, offset), size) uf + + let modify_offset uf v modification = + let ((t, offset), size) = ValMap.find v uf in + ValMap.add v ((t, modification offset), size) uf + + (** Returns true if each equivalence class in the data structure contains only one element, + i.e. every node is a root. *) + let is_empty uf = List.for_all (fun (v, (t, _)) -> Term.equal v (fst t)) (ValMap.bindings uf) + + (** Returns true if v is the representative value of its equivalence class. + + Throws "Unknown value" if v is not present in the data structure. *) + let is_root uf v = let (parent_t, _) = parent uf v in Term.equal v parent_t + + (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements + grouped by equivalence classes, while this function just prints them in any order. + + Throws "Unknown value" if v is not present in the data structure. *) + let show_uf_ugly uf = + List.fold_left (fun s (v, (refv, size)) -> + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Term.show v ^ + "; Parent: " ^ Term.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") + "" (ValMap.bindings uf) ^ "\n" + + (** + For a variable t it returns the reference variable v and the offset r. + This find performs path compression. + It returns als the updated union-find tree after the path compression. + + Throws "Unknown value" if t is not present in the data structure. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. + *) + let find uf v = + let (v',r') = parent uf v in + if Term.equal v' v then + (* v is a root *) + if Z.equal r' Z.zero then v',r', uf + else raise (InvalidUnionFind "non-zero self-distance!") + else if is_root uf v' then + (* the parent of v is a root *) + v',r', uf + else + let rec search v list = + let (v',r') = parent uf v in + if is_root uf v' then + (* perform path compresion *) + let (_,uf) = List.fold_left (fun (r0, uf) v -> + let (parent_v, r''), size_v = ValMap.find v uf in + let uf = modify_parent uf v (v',Z.(r0+r'')) in + let uf = modify_size parent_v uf (fun s -> s - size_v) in + let uf = modify_size v' uf ((+) size_v) + in Z.(r0+r''),uf) (Z.zero, uf) (v::list) + in v',r',uf + else search v' (v :: list) + in search v' [v] + + (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) + let find_opt uf v = match find uf v with + | exception (UnknownValue _) + | exception Not_found + | exception (InvalidUnionFind _) -> None + | res -> Some res + + (** + For a variable t it returns the reference variable v and the offset r. + This find DOES NOT perform path compression. + + Throws "Unknown value" if t is not present in the data structure. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. + *) + let rec find_no_pc uf v = + let (v',r') = parent uf v in + if Term.equal v' v then + if Z.equal r' Z.zero then (v',r') + else raise (InvalidUnionFind "non-zero self-distance!") + else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) + + let compare_repr = Tuple2.compare ~cmp1:Term.compare ~cmp2:Z.compare + + (** Compare only first element of the tuples (= the parent term). + It ignores the offset. *) + let compare_repr_v (v1, _) (v2, _) = Term.compare v1 v2 + + (** + Parameters: uf v1 v2 r + + changes the union find data structure `uf` such that the equivalence classes of `v1` and `v2` are merged and `v1 = v2 + r` + + returns v,uf,b where + + - `v` is the new reference variable of the merged equivalence class. It is either the old reference variable of v1 or of v2, depending on which equivalence class is bigger. + + - `uf` is the new union find data structure + + - `b` is true iff v = find v1 + + *) + let union uf v'1 v'2 r = + let v1,r1,uf = find uf v'1 in + let v2,r2,uf = find uf v'2 in + if Term.equal v1 v2 then + if Z.(equal r1 (r2 + r)) then v1, uf, true + else raise (Failure "incomparable union") + else let (_,s1), (_,s2) = ValMap.find v1 uf, ValMap.find v2 uf in + if s1 <= s2 then ( + v2, modify_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false + ) else ( + v1, modify_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true + ) + + (** Returns a list of equivalence classes. *) + let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) + + (** Throws "Unknown value" if the data structure is invalid. *) + let show_uf uf = List.fold_left (fun s eq_class -> + s ^ List.fold_left (fun s (v, (t, size)) -> + s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^Term.show v ^ "; P: " ^ Term.show (fst t) ^ + "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class + ^ "----\n") "" (get_eq_classes uf) ^ "\n" + +end + +(** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a set containing + all terms in the data structure that are equal to *(z + t').*) +module LookupMap = struct + module T = Term + module ZMap = struct + include Map.Make(Z) + let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 + end + + (* map: term -> z -> size of typ -> *(z + (typ * )t)*) + type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] + + let bindings = TMap.bindings + let add = TMap.add + let remove = TMap.remove + let empty = TMap.empty + let find_opt = TMap.find_opt + let find = TMap.find + + let zmap_bindings = ZMap.bindings + (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). *) + let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) + let zmap_find_opt = ZMap.find_opt + let set_any = TSet.any + + (** Merges the set "m" with the set that is already present in the data structure. *) + let zmap_add x y m = match zmap_find_opt x m with + | None -> ZMap.add x y m + | Some set -> ZMap.add x (TSet.union y set) m + + (** Returns the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) + let map_find_opt_set (v,r) map = match find_opt v map with + | None -> None + | Some zmap -> (match zmap_find_opt r zmap with + | None -> None + | Some v -> Some v + ) + + (** Returns one element of the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) + let map_find_opt (v,r) map = Option.map TSet.any (map_find_opt_set (v,r) map) + + (** Adds the term "v'" to the set that is already present in the data structure. *) + let map_add (v,r) v' map = let zmap = match find_opt v map with + | None -> ZMap.empty + | Some zmap ->zmap + in add v (zmap_add r (TSet.singleton v') zmap) map + + let show_map map = + List.fold_left + (fun s (v, zmap) -> + s ^ T.show v ^ "\t:\n" ^ + List.fold_left + (fun s (r, v) -> + s ^ "\t" ^ Z.to_string r ^ ": " ^ List.fold_left + (fun s k -> s ^ T.show k ^ ";") + "" (TSet.elements v) ^ ";; ") + "" (zmap_bindings zmap) ^ "\n") + "" (bindings map) + + let print_map = print_string % show_map + + (** The value at v' is shifted by r and then added for v. + The old entry for v' is removed. *) + let shift v r v' map = + match find_opt v' map with + | None -> map + | Some zmap -> let infl = zmap_bindings zmap in + let zmap = List.fold_left (fun zmap (r', v') -> + zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in + remove v' (add v zmap map) + + (** Find all outgoing edges of v in the automata.*) + let successors v map = + match find_opt v map with + | None -> [] + | Some zmap -> zmap_bindings_one_successor zmap + + (** Filters elements from the mapped values which fulfil the predicate p. *) + let filter_if map p = + TMap.filter_map (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ t_set -> let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) zmap + in if ZMap.is_empty zmap then None else Some zmap) map + + (** Maps elements from the mapped values by applying the function f to them. *) + let map_values map f = + TMap.map (fun zmap -> + ZMap.map (fun t_set -> TSet.map f t_set) zmap) map +end + (** Quantitative congruence closure on terms *) -module CongruenceClosure (Var : Val) = struct - module T = Term(Var) +module CongruenceClosure = struct + module T = Term - module TUF = UnionFind (T) - module LMap = LookupMap (T) + module TUF = UnionFind + module LMap = LookupMap (** Set of subterms which are present in the current data structure. *) module SSet = struct - module TSet = ValSet(T) type t = TSet.t [@@deriving eq, ord, hash] let elements = TSet.elements @@ -633,8 +618,6 @@ module CongruenceClosure (Var : Val) = struct (** Minimal representatives map. It maps each representative term of an equivalence class to the minimal term of this representative class. *) module MRMap = struct - module TMap = ValMap (T) - type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings @@ -737,8 +720,6 @@ module CongruenceClosure (Var : Val) = struct min_repr: MRMap.t} [@@deriving eq, ord, hash] - module TMap = ValMap(T) - let string_of_prop = function | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 @@ -1134,7 +1115,7 @@ module CongruenceClosure (Var : Val) = struct let show_new_parents_map new_parents_map = List.fold_left (fun s (v1, (v2, o2)) -> s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") - "" (LMap.bindings new_parents_map) + "" (TMap.bindings new_parents_map) (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index b1efafa8a8..7da6698380 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -4,7 +4,7 @@ open Batteries open GoblintCil module Var = CilType.Varinfo module CC = CongruenceClosure -include CC.CongruenceClosure(Var) +include CC.CongruenceClosure module M = Messages (**Find out if two addresses are not equal by using the MayPointTo query*) From addf77be90ad01c3039c66cce8ea9ac1c8b5e25f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 1 May 2024 15:22:32 +0200 Subject: [PATCH 094/323] added type information to terms --- .../weaklyRelationalPointerAnalysis.ml | 2 +- src/cdomains/congruenceClosure.ml | 147 +++++++++--------- src/cdomains/weaklyRelationalPointerDomain.ml | 9 +- 3 files changed, 82 insertions(+), 76 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 7beaf71e6c..3c3e2034cf 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -120,7 +120,7 @@ struct let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in if M.tracing then M.trace "wrpointer-function" "ENTER1: state_with_assignments: %s\n" (D.show state_with_assignments); (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = (List.map (fun v -> CC.Equal (CC.Deref (CC.Addr (duplicated_variable v),Z.zero), CC.Deref (CC.Addr v,Z.zero), Z.zero)) f.sformals) in + let added_equalities = (List.map (fun v -> CC.Equal (T.deref_term (CC.Addr (duplicated_variable v)) Z.zero, T.deref_term (CC.Addr v) Z.zero, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities state_with_assignments in if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Disequalities.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index f08be51b50..3deb64a561 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -7,34 +7,43 @@ module M = Messages exception Unsat -type 'v term = Addr of 'v | Deref of 'v term * Z.t [@@deriving eq, ord, hash] -type 'v prop = Equal of 'v term * 'v term * Z.t | Nequal of 'v term * 'v term * Z.t [@@deriving eq, ord, hash] +type ('v, 't) term = Addr of 'v | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] +type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t [@@deriving eq, ord, hash] -module Term = struct - type t = Var.t term [@@deriving eq, ord, hash] - type v_prop = Var.t prop [@@deriving eq, ord, hash] +(*terms*) +module T = struct + type typ = Cil.typ + (*equality of terms should not depend on types*) + let compare_typ _ _ = 0 + let equal_typ _ _ = true + let hash_typ _ = 1 + + + (* term * size in bits of the element pointed to by the term *) + type t = (Var.t, typ) term [@@deriving eq, ord, hash] + type v_prop = (Var.t, typ) prop [@@deriving eq, ord, hash] let props_equal = List.equal equal_v_prop - let rec show = function + let rec show : t -> string = function | Addr v -> "&" ^ Var.show v - | Deref (Addr v, z) when Z.equal z Z.zero -> Var.show v - | Deref (t, z) when Z.equal z Z.zero -> "*" ^ show t - | Deref (t, z) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" + | Deref (Addr v, z, _) when Z.equal z Z.zero -> Var.show v + | Deref (t, z, typ) when Z.equal z Z.zero -> "*" ^ show t + | Deref (t, z, typ) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" (** Returns true if the first parameter is a subterm of the second one. *) let rec is_subterm st term = equal st term || match term with - | Deref (t, _) -> is_subterm st t + | Deref (t, _, _) -> is_subterm st t | _ -> false (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) let rec contains_variable variables term = match term with - | Deref (t, _) -> contains_variable variables t + | Deref (t, _, _) -> contains_variable variables t | Addr v -> List.mem v variables let rec get_var = function | Addr v -> v - | Deref (t, _) -> get_var t + | Deref (t, _, _) -> get_var t exception UnsupportedCilExpression of string @@ -74,6 +83,7 @@ module Term = struct match typ with | TArray (typ, _, _) -> get_element_size_in_bits typ | TPtr (typ, _) -> get_size_in_bits typ + (*TODO TComp*) | _ -> get_size_in_bits typ let is_array_type = function @@ -88,7 +98,6 @@ module Term = struct | TPtr(TComp _,_) -> true | _ -> false - let cil_offs_to_idx (ask: Queries.ask) offs typ = (* TODO: Some duplication with convert_offset in base.ml and cil_offs_to_idx in memOutOfBounds.ml, unclear how to immediately get more reuse *) @@ -122,21 +131,19 @@ module Term = struct | typ -> typ in remove_array_and_struct_types typ - let rec type_of_term ask = - let get_field_at_index z typ = - List.find (fun field -> Z.equal (z_of_offset ask (Field (field, NoOffset)) typ) z) - in function - | (Addr x) -> TPtr (x.vtype,[]) - | (Deref (Addr x, z)) -> begin match x.vtype with (*TODO this doesnt work for arrays of arrays of structs ecc*) - | TComp (cinfo, _) -> (get_field_at_index z x.vtype cinfo.cfields).ftype - | _ -> x.vtype - end - | (Deref (t, z)) -> dereference_type (type_of_term ask t) + let rec type_of_term = + function + | (Addr v) -> TPtr (v.vtype, []) + | (Deref (_, _, typ)) -> typ + + + let deref_term t z = Deref (t, z, dereference_type (type_of_term t)) + let rec of_offset ask t off typ = if off = NoOffset then t else let z = z_of_offset ask off typ in - Deref (t, z) + Deref (t, z, dereference_type typ) (** Converts a cil expression to Some term, Some offset; or None, Some offset is the expression equals an integer, @@ -178,8 +185,8 @@ module Term = struct | CastE (typ, exp)-> of_cil ask exp | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") and of_lval ask lval = let res = match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype - else of_offset ask (Deref (Addr var, Z.zero)) off var.vtype + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (*TODO typ?*) + else of_offset ask (Deref (Addr var, Z.zero, var.vtype)) off var.vtype | (Mem exp, off) -> begin match of_cil ask exp with | (Some term, offset) -> @@ -187,9 +194,9 @@ module Term = struct if is_struct_ptr_type typ then match of_offset ask term off typ with | Addr x -> Addr x - | Deref (x, z) -> Deref (x, Z.(z+offset)) + | Deref (x, z, typ) -> Deref (x, Z.(z+offset), typ) else - of_offset ask (Deref (term, offset)) off typ + of_offset ask (Deref (term, offset, typ)) off typ | _ -> raise (UnsupportedCilExpression "cannot dereference constant") end in (if M.tracing then match res with @@ -272,45 +279,45 @@ module Term = struct (** Convert a term to a cil expression and its cil type. *) let rec to_cil ask off t = - let cil_t, vtyp = match t with - | Addr v -> AddrOf (Var v, NoOffset), TPtr (v.vtype, []) - | Deref (Addr v, z) when Z.equal z Z.zero -> Lval (Var v, NoOffset), v.vtype - | Deref (t, z) -> - let cil_t, vtyp = to_cil ask z t in + let cil_t = match t with + | Addr v -> AddrOf (Var v, NoOffset) + | Deref (Addr v, z, typ) when Z.equal z Z.zero -> Lval (Var v, NoOffset) + | Deref (t, z, vtyp) -> + let cil_t = to_cil ask z t in begin match vtyp with - | TPtr (typ,_) -> Lval (Mem cil_t, NoOffset), typ - | TArray (typ, length, _) -> Lval (Mem (CastE (TPtr (typ,[]), cil_t)), NoOffset), typ (*TODO**) - | TComp (icomp, _) -> Lval (Mem cil_t, NoOffset), (List.first icomp.cfields).ftype(*TODO**) + | TPtr (typ,_) -> Lval (Mem cil_t, NoOffset) + | TArray (typ, length, _) -> Lval (Mem (CastE (TPtr (typ,[]), cil_t)), NoOffset) (*TODO**) + | TComp (icomp, _) -> Lval (Mem cil_t, NoOffset) | TVoid _ | TInt (_, _) | TFloat (_, _) | TFun (_, _, _, _) | TNamed (_, _) | TEnum (_, _) - | TBuiltin_va_list _ -> cil_t, vtyp + | TBuiltin_va_list _ -> cil_t end - in if Z.(equal zero off) then cil_t, vtyp else - match vtyp with - | TArray (typ, length, _) -> cil_t, vtyp + in if Z.(equal zero off) then cil_t else + let vtype = type_of_term t in + match vtype with + | TArray (typ, length, _) -> cil_t | _ -> - BinOp (PlusPI, cil_t, to_cil_constant ask off vtyp, vtyp), vtyp + BinOp (PlusPI, cil_t, to_cil_constant ask off vtype, vtype) (** Convert a term to a cil expression. *) - let to_cil ask off t = let exp, typ = to_cil ask off t in - if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Offset: %s; Exp: %a; Typ: %a\n" - (show t) (Z.to_string off) d_plainexp exp d_plaintype typ; + let to_cil ask off t = let exp = to_cil ask off t in + if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Offset: %s; Exp: %a\n" + (show t) (Z.to_string off) d_plainexp exp; exp - end module TMap = struct - include Map.Make(Term) - let hash node_hash y = fold (fun x node acc -> acc + Term.hash x + node_hash node) y 0 + include Map.Make(T) + let hash node_hash y = fold (fun x node acc -> acc + T.hash x + node_hash node) y 0 end module TSet = struct - include Set.Make(Term) - let hash x = fold (fun x y -> y + Term.hash x) x 0 + include Set.Make(T) + let hash x = fold (fun x y -> y + T.hash x) x 0 end (** Quantitative union find *) @@ -320,9 +327,9 @@ module UnionFind = struct (** (value * offset) ref * size of equivalence class *) type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] - type t = Term.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) + type t = T.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) - exception UnknownValue of Term.t + exception UnknownValue of T.t exception InvalidUnionFind of string let empty = ValMap.empty @@ -355,7 +362,7 @@ module UnionFind = struct let (p, old_size) = ValMap.find t uf in let uf = ValMap.add t (p, modification old_size) uf in let parent = fst p in - if Term.equal parent t then uf else modify_size parent uf modification + if T.equal parent t then uf else modify_size parent uf modification let modify_parent uf v (t, offset) = let (_, size) = ValMap.find v uf in @@ -367,12 +374,12 @@ module UnionFind = struct (** Returns true if each equivalence class in the data structure contains only one element, i.e. every node is a root. *) - let is_empty uf = List.for_all (fun (v, (t, _)) -> Term.equal v (fst t)) (ValMap.bindings uf) + let is_empty uf = List.for_all (fun (v, (t, _)) -> T.equal v (fst t)) (ValMap.bindings uf) (** Returns true if v is the representative value of its equivalence class. Throws "Unknown value" if v is not present in the data structure. *) - let is_root uf v = let (parent_t, _) = parent uf v in Term.equal v parent_t + let is_root uf v = let (parent_t, _) = parent uf v in T.equal v parent_t (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements grouped by equivalence classes, while this function just prints them in any order. @@ -380,8 +387,8 @@ module UnionFind = struct Throws "Unknown value" if v is not present in the data structure. *) let show_uf_ugly uf = List.fold_left (fun s (v, (refv, size)) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ Term.show v ^ - "; Parent: " ^ Term.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ T.show v ^ + "; Parent: " ^ T.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") "" (ValMap.bindings uf) ^ "\n" (** @@ -394,7 +401,7 @@ module UnionFind = struct *) let find uf v = let (v',r') = parent uf v in - if Term.equal v' v then + if T.equal v' v then (* v is a root *) if Z.equal r' Z.zero then v',r', uf else raise (InvalidUnionFind "non-zero self-distance!") @@ -432,16 +439,16 @@ module UnionFind = struct *) let rec find_no_pc uf v = let (v',r') = parent uf v in - if Term.equal v' v then + if T.equal v' v then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) - let compare_repr = Tuple2.compare ~cmp1:Term.compare ~cmp2:Z.compare + let compare_repr = Tuple2.compare ~cmp1:T.compare ~cmp2:Z.compare (** Compare only first element of the tuples (= the parent term). It ignores the offset. *) - let compare_repr_v (v1, _) (v2, _) = Term.compare v1 v2 + let compare_repr_v (v1, _) (v2, _) = T.compare v1 v2 (** Parameters: uf v1 v2 r @@ -460,7 +467,7 @@ module UnionFind = struct let union uf v'1 v'2 r = let v1,r1,uf = find uf v'1 in let v2,r2,uf = find uf v'2 in - if Term.equal v1 v2 then + if T.equal v1 v2 then if Z.(equal r1 (r2 + r)) then v1, uf, true else raise (Failure "incomparable union") else let (_,s1), (_,s2) = ValMap.find v1 uf, ValMap.find v2 uf in @@ -476,7 +483,7 @@ module UnionFind = struct (** Throws "Unknown value" if the data structure is invalid. *) let show_uf uf = List.fold_left (fun s eq_class -> s ^ List.fold_left (fun s (v, (t, size)) -> - s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^Term.show v ^ "; P: " ^ Term.show (fst t) ^ + s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^T.show v ^ "; P: " ^ T.show (fst t) ^ "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class ^ "----\n") "" (get_eq_classes uf) ^ "\n" @@ -485,7 +492,6 @@ end (** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a set containing all terms in the data structure that are equal to *(z + t').*) module LookupMap = struct - module T = Term module ZMap = struct include Map.Make(Z) let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 @@ -575,7 +581,6 @@ end (** Quantitative congruence closure on terms *) module CongruenceClosure = struct - module T = Term module TUF = UnionFind module LMap = LookupMap @@ -597,7 +602,7 @@ module CongruenceClosure = struct (** Adds all subterms of t to the SSet and the LookupMap*) let rec subterms_of_term (set,map) t = match t with | Addr _ -> (add t set, map) - | Deref (t',z) -> + | Deref (t',z,_) -> let set = add t set in let map = LMap.map_add (t',z) t map in subterms_of_term (set, map) t' @@ -644,7 +649,7 @@ module CongruenceClosure = struct let process_edge (min_representatives, queue, uf) (edge_z, next_term) = let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in - let next_min = (Deref (min_term, Z.(edge_z - min_z)), next_z) in + let next_min = (T.deref_term min_term Z.(edge_z - min_z), next_z) in match TMap.find_opt next_state min_representatives with | None -> @@ -759,9 +764,9 @@ module CongruenceClosure = struct List.filter_map (fun (z,s,(s',z')) -> let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in - normalize_equality (Deref(min_state, Z.(z - min_z)), min_state', Z.(z' - min_z')) + normalize_equality (T.deref_term min_state Z.(z - min_z), min_state', Z.(z' - min_z')) ) transitions - in BatList.sort_unique (compare_prop Var.compare) (conjunctions_of_atoms @ conjunctions_of_transitions) + in BatList.sort_unique (compare_prop Var.compare (T.compare_typ)) (conjunctions_of_atoms @ conjunctions_of_transitions) let show_all x = "Normal form:\n" ^ show_conj((get_normal_form x)) ^ @@ -912,7 +917,7 @@ module CongruenceClosure = struct let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in (t, Z.zero), {uf; set; map = cc.map; min_repr}, [Addr a] - | Deref (t', z) -> + | Deref (t', z, _) -> let (v, r), cc, queue = insert_no_min_repr cc t' in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in @@ -1002,7 +1007,7 @@ module CongruenceClosure = struct let rec detect_cyclic_dependencies t1 t2 cc = match t1 with | Addr v -> false - | Deref (t1, _) -> + | Deref (t1, _, _) -> let v1, o1 = TUF.find_no_pc cc.uf t1 in let v2, o2 = TUF.find_no_pc cc.uf t2 in if T.equal v1 v2 then true else @@ -1012,7 +1017,7 @@ module CongruenceClosure = struct let add_one_successor (cc, successors) (edge_z, _) = let _, uf_offset, uf = TUF.find cc.uf t in let cc = {cc with uf = uf} in - let successor = Deref (t, Z.(edge_z - uf_offset)) in + let successor = T.deref_term t Z.(edge_z - uf_offset) in let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] else insert_no_min_repr cc successor in diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 7da6698380..1b1d052adc 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -6,6 +6,7 @@ module Var = CilType.Varinfo module CC = CongruenceClosure include CC.CongruenceClosure module M = Messages +module T = CC.T (**Find out if two addresses are not equal by using the MayPointTo query*) module Disequalities = struct @@ -22,9 +23,9 @@ module Disequalities = struct if T.equal t1 t2 then true else (* two local arrays can never point to the same array *) let are_different_arrays = match t1, t2 with - | Deref (Addr x1, z1), Deref (Addr x2, z2) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false + | Deref (Addr x1, z1,_), Deref (Addr x2, z2,_) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false | _ -> false in - if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term ask t1)) (T.get_var t1) || Var.equal (dummy_varinfo (T.type_of_term ask t2)) (T.get_var t2) then false else + if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (dummy_varinfo (T.type_of_term t2)) (T.get_var t2) then false else let exp1 = T.to_cil ask Z.zero t1 in let exp2 = T.to_cil ask off t2 in let mpt1 = ask.f (MayPointTo exp1) in @@ -40,10 +41,10 @@ module Disequalities = struct if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) in match t1, t2 with - | CC.Deref (t, z), CC.Deref (v, z') -> + | CC.Deref (t, z,_), CC.Deref (v, z',_) -> let (q', z1') = TUF.find_no_pc uf v in let (q, z1) = TUF.find_no_pc uf t in - let s' = T.get_size_in_bits (T.type_of_term ask t2) in + let s' = T.get_size_in_bits (T.type_of_term t2) in let diff = Z.(-z' - z1 + z1' + z) in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( From d8c484a046011502d7eddb8514171cd393e8e628 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 3 May 2024 13:40:00 +0200 Subject: [PATCH 095/323] added size of variables to the data structure; added distinct dummy and return variables; changed typ to exp as additional information for the terms, therefore simplified the function for finding the cil term starting; fixed some bugs; --- .../weaklyRelationalPointerAnalysis.ml | 10 +- src/cdomains/congruenceClosure.ml | 255 +++++++++++------- src/cdomains/weaklyRelationalPointerDomain.ml | 20 +- 3 files changed, 172 insertions(+), 113 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 3c3e2034cf..80b58aa0bf 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -56,13 +56,13 @@ struct (* Definite assignment *) | lterm, (Some term, Some offset) -> let dummy_var = Disequalities.dummy_var (typeOfLval lval) in - if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s\n" (T.show lterm) (T.show term) (Z.to_string offset); + if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> D.remove_terms_containing_variable dummy_var (* invertibe assignment *) - | exception (T.UnsupportedCilExpression _) -> t + | exception (T.UnsupportedCilExpression _) -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) let assign_lval_2_ask t (ask1: Queries.ask) (ask2: Queries.ask) lval expr = @@ -94,7 +94,7 @@ struct let return ctx exp_opt f = let res = match exp_opt with | Some e -> - assign_return (ask_of_ctx ctx) ctx.local (Disequalities.dummy_var (typeOf e)) e + assign_return (ask_of_ctx ctx) ctx.local (Disequalities.return_var (typeOf e)) e | None -> ctx.local in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Disequalities.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res @@ -138,13 +138,13 @@ struct if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (Disequalities.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t - | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var (Disequalities.dummy_lval (typeOfLval var)) + | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var (Disequalities.return_lval (typeOfLval var)) in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in let t = - D.remove_terms_containing_variables (Disequalities.dummy_varinfo (TVoid [])::local_vars @ duplicated_vars) t + D.remove_terms_containing_variables (Disequalities.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t (*ctx.local is after combine_env, t callee*) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 3deb64a561..a917838cdd 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -12,24 +12,35 @@ type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of (' (*terms*) module T = struct - type typ = Cil.typ - (*equality of terms should not depend on types*) - let compare_typ _ _ = 0 - let equal_typ _ _ = true - let hash_typ _ = 1 + type exp = Cil.exp + (*equality of terms should not depend on the expression*) + let compare_exp _ _ = 0 + let equal_exp _ _ = true + let hash_exp _ = 1 (* term * size in bits of the element pointed to by the term *) - type t = (Var.t, typ) term [@@deriving eq, ord, hash] - type v_prop = (Var.t, typ) prop [@@deriving eq, ord, hash] + type t = (Var.t, exp) term [@@deriving eq, ord, hash] + type v_prop = (Var.t, exp) prop [@@deriving eq, ord, hash] let props_equal = List.equal equal_v_prop + let show_type exp = + let typ = typeOf exp in + "[" ^ (match typ with + | TPtr _ -> "Ptr" + | TInt _ -> "Int" + | TArray _ -> "Arr" + | TVoid _ -> "Voi" + | TFloat (_, _)-> "Flo" + | TComp (_, _) -> "TCo" + | TFun (_, _, _, _)|TNamed (_, _)|TEnum (_, _)|TBuiltin_va_list _ -> "?" + )^string_of_int (bitsSizeOf typ) ^ "]" let rec show : t -> string = function | Addr v -> "&" ^ Var.show v - | Deref (Addr v, z, _) when Z.equal z Z.zero -> Var.show v - | Deref (t, z, typ) when Z.equal z Z.zero -> "*" ^ show t - | Deref (t, z, typ) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")" + | Deref (Addr v, z, exp) when Z.equal z Z.zero -> Var.show v ^ show_type exp + | Deref (t, z, exp) when Z.equal z Z.zero -> "*" ^ show t^ show_type exp + | Deref (t, z, exp) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")"^ show_type exp (** Returns true if the first parameter is a subterm of the second one. *) let rec is_subterm st term = equal st term || match term with @@ -116,14 +127,17 @@ module T = struct in PreValueDomain.Offs.to_index ?typ:(Some typ) (convert_offset offs) - let z_of_offset ask offs typ = match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i | None -> raise (UnsupportedCilExpression "unknown offset") + let can_be_dereferenced = function + | TPtr _| TArray _| TComp _ -> true + | _ -> false + (** For a type TPtr(t) it returns the type t. *) - let dereference_type = function + let dereference_type = function (*TODO*) | TPtr (typ, _) -> typ | typ -> let rec remove_array_and_struct_types = function | TArray (typ, _, _) -> remove_array_and_struct_types typ @@ -134,16 +148,68 @@ module T = struct let rec type_of_term = function | (Addr v) -> TPtr (v.vtype, []) - | (Deref (_, _, typ)) -> typ + | (Deref (_, _, exp)) -> typeOf exp + let to_cil = + function + | (Addr v) -> AddrOf (Var v, NoOffset) + | (Deref (_, _, exp)) -> exp - let deref_term t z = Deref (t, z, dereference_type (type_of_term t)) + let to_cil t = let exp = to_cil t in + if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Exp: %a\n" + (show t) d_plainexp exp; + exp + let default_int_type = ILong + let to_cil_constant z t = let z = Z.(z/ get_element_size_in_bits t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) - let rec of_offset ask t off typ = + let to_cil_sum ask off t = + let cil_t = to_cil t in + if Z.(equal zero off) then cil_t else + let vtype = type_of_term t in + match vtype with + | TArray (typ, length, _) -> cil_t + | _ -> + BinOp (PlusPI, cil_t, to_cil_constant off vtype, vtype) + + let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with + | Some i -> i + | None -> raise (UnsupportedCilExpression "unknown offset") + + let dereference_exp exp offset = + match exp with + | AddrOf lval -> Lval lval + | _ -> + match typeOf exp with + | TPtr (typ, _) when Z.equal offset Z.zero -> Lval (Mem exp, NoOffset) + | TPtr (typ, _) -> + BinOp (PlusPI, Lval (Mem exp, NoOffset), to_cil_constant offset typ, typeOfLval (Mem exp, NoOffset)) + | TArray (typ, _, _) when not (can_be_dereferenced typ) -> + let index = Index (to_cil_constant offset typ, NoOffset) in + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + | TComp (cinfo, _) -> + if M.tracing then M.trace "wrpointer2" "%a\n" d_exp exp; + let finfo = List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields in + let index = Field (finfo, NoOffset) in + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), exp)), NoOffset) + + let get_size = get_size_in_bits % type_of_term + + let deref_term t z = Deref (t, z, dereference_exp (to_cil t) z) + + let rec of_offset ask t off typ exp = if off = NoOffset then t else let z = z_of_offset ask off typ in - Deref (t, z, dereference_type typ) + Deref (t, z, exp) (** Converts a cil expression to Some term, Some offset; or None, Some offset is the expression equals an integer, @@ -182,21 +248,25 @@ module T = struct end | _ -> raise (UnsupportedCilExpression "unsupported BinOp") end - | CastE (typ, exp)-> of_cil ask exp + | CastE (typ, exp)-> begin match of_cil ask exp with + | Some (Addr x), z -> Some (Addr x), z + | Some (Deref (x, z, old_exp)), z' -> Some (Deref (x, z, CastE (typ, exp))), z' + | t, z -> t, z + end | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") and of_lval ask lval = let res = match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (*TODO typ?*) - else of_offset ask (Deref (Addr var, Z.zero, var.vtype)) off var.vtype + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) + else of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) | (Mem exp, off) -> begin match of_cil ask exp with | (Some term, offset) -> - let typ = Cilfacade.typeOf exp in + let typ = typeOf exp in if is_struct_ptr_type typ then - match of_offset ask term off typ with + match of_offset ask term off typ (Lval lval) with | Addr x -> Addr x - | Deref (x, z, typ) -> Deref (x, Z.(z+offset), typ) + | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) else - of_offset ask (Deref (term, offset, typ)) off typ + of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) | _ -> raise (UnsupportedCilExpression "cannot dereference constant") end in (if M.tracing then match res with @@ -272,42 +342,6 @@ module T = struct end | UnOp (LNot, e1, _) -> prop_of_cil ask e1 (not pos) | _ -> [] - - - let default_int_type = IInt - let to_cil_constant ask z t = let z = Z.(z/ get_element_size_in_bits t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) - - (** Convert a term to a cil expression and its cil type. *) - let rec to_cil ask off t = - let cil_t = match t with - | Addr v -> AddrOf (Var v, NoOffset) - | Deref (Addr v, z, typ) when Z.equal z Z.zero -> Lval (Var v, NoOffset) - | Deref (t, z, vtyp) -> - let cil_t = to_cil ask z t in - begin match vtyp with - | TPtr (typ,_) -> Lval (Mem cil_t, NoOffset) - | TArray (typ, length, _) -> Lval (Mem (CastE (TPtr (typ,[]), cil_t)), NoOffset) (*TODO**) - | TComp (icomp, _) -> Lval (Mem cil_t, NoOffset) - | TVoid _ - | TInt (_, _) - | TFloat (_, _) - | TFun (_, _, _, _) - | TNamed (_, _) - | TEnum (_, _) - | TBuiltin_va_list _ -> cil_t - end - in if Z.(equal zero off) then cil_t else - let vtype = type_of_term t in - match vtype with - | TArray (typ, length, _) -> cil_t - | _ -> - BinOp (PlusPI, cil_t, to_cil_constant ask off vtype, vtype) - - (** Convert a term to a cil expression. *) - let to_cil ask off t = let exp = to_cil ask off t in - if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Offset: %s; Exp: %a\n" - (show t) (Z.to_string off) d_plainexp exp; - exp end module TMap = struct @@ -498,7 +532,7 @@ module LookupMap = struct end (* map: term -> z -> size of typ -> *(z + (typ * )t)*) - type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] + type t = TSet.t ZMap.t ZMap.t TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings let add = TMap.add @@ -507,41 +541,54 @@ module LookupMap = struct let find_opt = TMap.find_opt let find = TMap.find - let zmap_bindings = ZMap.bindings - (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). *) - let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) - let zmap_find_opt = ZMap.find_opt + let zmap_bindings zmap = + let distribute_pair (a, xs) = List.map (fun (x,y) -> (a,x,y)) xs in + (List.flatten @@ List.map distribute_pair + (List.map (Tuple2.map2 ZMap.bindings) (ZMap.bindings zmap))) + + let zmap_bindings_of_size s zmap = + List.filter_map (fun (off, zmap1) -> + Option.map (fun x -> (off, x)) @@ ZMap.find_opt s zmap1 + ) (ZMap.bindings zmap) + + (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). + It returns a list of (offset, size, term) *) + let zmap_bindings_one_successor (zmap:TSet.t ZMap.t ZMap.t) = + List.map (Tuple3.map3 TSet.any) (zmap_bindings zmap) + let zmap_find_opt t size = Option.map_default (ZMap.find_opt size) None % ZMap.find_opt t let set_any = TSet.any - (** Merges the set "m" with the set that is already present in the data structure. *) - let zmap_add x y m = match zmap_find_opt x m with - | None -> ZMap.add x y m - | Some set -> ZMap.add x (TSet.union y set) m + (** Merges the set "m" with the set that is already present in the data structure. + Params: x, size, set m, map.*) + let zmap_add x size y m = match ZMap.find_opt x m with + | None -> ZMap.add x (ZMap.add size y ZMap.empty) m + | Some zmap2 -> match ZMap.find_opt size zmap2 with + | None -> ZMap.add x (ZMap.add size y zmap2) m + | Some set -> ZMap.add x (ZMap.add size (TSet.union y set) zmap2) m (** Returns the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt_set (v,r) map = match find_opt v map with + let map_find_opt_set (v,r) size map = match find_opt v map with | None -> None - | Some zmap -> (match zmap_find_opt r zmap with - | None -> None - | Some v -> Some v - ) + | Some zmap -> zmap_find_opt r size zmap (** Returns one element of the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt (v,r) map = Option.map TSet.any (map_find_opt_set (v,r) map) + let map_find_opt (v,r) size map = Option.map TSet.any (map_find_opt_set (v,r) size map) (** Adds the term "v'" to the set that is already present in the data structure. *) - let map_add (v,r) v' map = let zmap = match find_opt v map with + let map_add (v,r) v' map = + let size = T.get_size v' in + let zmap = match find_opt v map with | None -> ZMap.empty - | Some zmap ->zmap - in add v (zmap_add r (TSet.singleton v') zmap) map + | Some zmap -> zmap + in add v (zmap_add r size (TSet.singleton v') zmap) map let show_map map = List.fold_left (fun s (v, zmap) -> s ^ T.show v ^ "\t:\n" ^ List.fold_left - (fun s (r, v) -> - s ^ "\t" ^ Z.to_string r ^ ": " ^ List.fold_left + (fun s (r, size, v) -> + s ^ "\t" ^ Z.to_string r ^ "(" ^ Z.to_string size ^ "bits): " ^ List.fold_left (fun s k -> s ^ T.show k ^ ";") "" (TSet.elements v) ^ ";; ") "" (zmap_bindings zmap) ^ "\n") @@ -555,8 +602,8 @@ module LookupMap = struct match find_opt v' map with | None -> map | Some zmap -> let infl = zmap_bindings zmap in - let zmap = List.fold_left (fun zmap (r', v') -> - zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in + let zmap = List.fold_left (fun zmap (r', s', v') -> + zmap_add Z.(r' + r) s' v' zmap) ZMap.empty infl in remove v' (add v zmap map) (** Find all outgoing edges of v in the automata.*) @@ -568,15 +615,18 @@ module LookupMap = struct (** Filters elements from the mapped values which fulfil the predicate p. *) let filter_if map p = TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ t_set -> let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) zmap - in if ZMap.is_empty zmap then None else Some zmap) map + let zmap = ZMap.filter_map (fun _ zmap2 -> + let zmap2 = ZMap.filter_map + (fun _ t_set -> let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) zmap2 + in if ZMap.is_empty zmap2 then None else Some zmap2) zmap + in if ZMap.is_empty zmap then None else Some zmap) + map (** Maps elements from the mapped values by applying the function f to them. *) let map_values map f = TMap.map (fun zmap -> - ZMap.map (fun t_set -> TSet.map f t_set) zmap) map + ZMap.map (fun zmap2 -> ZMap.map (fun t_set -> TSet.map f t_set) zmap2) zmap) map end (** Quantitative congruence closure on terms *) @@ -646,7 +696,7 @@ module CongruenceClosure = struct | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match LMap.successors state map with | edges -> - let process_edge (min_representatives, queue, uf) (edge_z, next_term) = + let process_edge (min_representatives, queue, uf) (edge_z, _(*min_repr is independent of the size*), next_term) = let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in let next_min = (T.deref_term min_term Z.(edge_z - min_z), next_z) in @@ -739,8 +789,8 @@ module CongruenceClosure = struct (** Returns a list of all the transition that are present in the automata. *) let get_transitions (uf, map) = List.flatten @@ List.map (fun (t, zmap) -> - (List.map (fun (edge_z, res_t) -> - (edge_z, t, TUF.find_no_pc uf (LMap.set_any res_t))) @@ + (List.map (fun (edge_z, edge_size, res_t) -> + (edge_z, t, edge_size, TUF.find_no_pc uf (LMap.set_any res_t))) @@ (LMap.zmap_bindings zmap))) (LMap.bindings map) @@ -761,12 +811,12 @@ module CongruenceClosure = struct in let conjunctions_of_transitions = let transitions = get_transitions (cc.uf, cc.map) in - List.filter_map (fun (z,s,(s',z')) -> + List.filter_map (fun (z,s,_ (*size is not important for normal form?*),(s',z')) -> let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in normalize_equality (T.deref_term min_state Z.(z - min_z), min_state', Z.(z' - min_z')) ) transitions - in BatList.sort_unique (compare_prop Var.compare (T.compare_typ)) (conjunctions_of_atoms @ conjunctions_of_transitions) + in BatList.sort_unique (compare_prop Var.compare (T.compare_exp)) (conjunctions_of_atoms @ conjunctions_of_transitions) let show_all x = "Normal form:\n" ^ show_conj((get_normal_form x)) ^ @@ -816,6 +866,10 @@ module CongruenceClosure = struct | (t1, t2, r)::rest -> (let v1, r1, uf = TUF.find uf t1 in let v2, r2, uf = TUF.find uf t2 in + let sizet1, sizet2 = T.get_size t1, T.get_size t2 in + if not (Z.equal sizet1 sizet2) then + (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same"; + closure (uf, map, min_repr) queue rest) else if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) if Z.equal r1 Z.(r2 + r) then closure (uf, map, min_repr) queue rest @@ -831,23 +885,24 @@ module CongruenceClosure = struct | Some imap1, Some imap2, true -> (* v1 is new root *) (* zmap describes args of Deref *) let r0 = Z.(r2-r1+r) in (* difference between roots *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in + (* we move all entries of imap2 to imap1 *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings_of_size sizet1 imap2) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = match LMap.zmap_find_opt r' zmap with + let rest = match LMap.zmap_find_opt r' sizet1 zmap with | None -> rest | Some v'' -> (LMap.set_any v', LMap.set_any v'',Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) + in LMap.zmap_add r' sizet1 v' zmap, rest) (imap1,rest) infl2 in LMap.remove v2 (LMap.add v zmap map), rest | Some imap1, Some imap2, false -> (* v2 is new root *) let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings_of_size sizet1 imap1) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> let rest = - match LMap.zmap_find_opt r' zmap with + match LMap.zmap_find_opt r' sizet1 zmap with | None -> rest | Some v'' -> (LMap.set_any v',LMap.set_any v'',Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in + in LMap.zmap_add r' sizet1 v' zmap, rest) (imap2, rest) infl1 in LMap.remove v1 (LMap.add v zmap map), rest in (* update min_repr *) @@ -917,11 +972,11 @@ module CongruenceClosure = struct let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in (t, Z.zero), {uf; set; map = cc.map; min_repr}, [Addr a] - | Deref (t', z, _) -> + | Deref (t', z, exp) -> let (v, r), cc, queue = insert_no_min_repr cc t' in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - match LMap.map_find_opt (v, Z.(r + z)) cc.map with + match LMap.map_find_opt (v, Z.(r + z)) (T.get_size_in_bits (typeOf exp)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in (v2,z2), closure {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr} [(t, v', Z.zero)], v::queue @@ -1014,7 +1069,7 @@ module CongruenceClosure = struct detect_cyclic_dependencies t1 t2 cc let add_successor_terms cc t = - let add_one_successor (cc, successors) (edge_z, _) = + let add_one_successor (cc, successors) (edge_z, _, _) = let _, uf_offset, uf = TUF.find cc.uf t in let cc = {cc with uf = uf} in let successor = T.deref_term t Z.(edge_z - uf_offset) in diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 1b1d052adc..61fbbc9a8e 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -12,10 +12,14 @@ module T = CC.T module Disequalities = struct module AD = ValueDomain.AD - + (*TODO: id should not clash with the other dummy values we have for function parameters*) let dummy_varinfo typ = {dummyFunDec.svar with vtype=typ} - let dummy_var var = CC.Addr (dummy_varinfo var) - let dummy_lval var = AddrOf (Var (dummy_varinfo var), NoOffset) + let dummy_var var = T.deref_term (CC.Addr (dummy_varinfo var)) Z.zero + let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) + + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=dummyFunDec.svar.vid-1;vname="@return"} + let return_var var = T.deref_term (CC.Addr (return_varinfo var)) Z.zero + let return_lval var = Lval (Var (return_varinfo var), NoOffset) (**Find out if two addresses are possibly equal by using the MayPointTo query. The parameter s is the size (in bits) of the value that t1 points to. *) @@ -25,13 +29,13 @@ module Disequalities = struct let are_different_arrays = match t1, t2 with | Deref (Addr x1, z1,_), Deref (Addr x2, z2,_) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false | _ -> false in - if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (dummy_varinfo (T.type_of_term t2)) (T.get_var t2) then false else - let exp1 = T.to_cil ask Z.zero t1 in - let exp2 = T.to_cil ask off t2 in + if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t2)) (T.get_var t2) then false else + let exp1 = T.to_cil t1 in + let exp2 = T.to_cil_sum ask off t2 in let mpt1 = ask.f (MayPointTo exp1) in let mpt2 = ask.f (MayPointTo exp2) in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto" "QUERY MayPointTo. \nt1: %s; exp1: %a; res: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nt1: %s; exp1: %a; res: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" (T.show t1) d_plainexp exp1 AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res (**Returns true iff by assigning to t1, the value of t2 could change. @@ -44,7 +48,7 @@ module Disequalities = struct | CC.Deref (t, z,_), CC.Deref (v, z',_) -> let (q', z1') = TUF.find_no_pc uf v in let (q, z1) = TUF.find_no_pc uf t in - let s' = T.get_size_in_bits (T.type_of_term t2) in + let s' = T.get_size t2 in let diff = Z.(-z' - z1 + z1' + z) in (* If they are in the same equivalence class but with a different offset, then they are not equal *) ( From 5889a941f3d66db48034af8a93d726ece263ef10 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 3 May 2024 16:23:41 +0200 Subject: [PATCH 096/323] modified some tests --- tests/regression/79-wrpointer/03-function-call.c | 13 ++++++++++--- .../regression/79-wrpointer/10-different-types.c | 16 ++++++++-------- tests/regression/79-wrpointer/13-experiments.c | 6 +++--- 3 files changed, 21 insertions(+), 14 deletions(-) diff --git a/tests/regression/79-wrpointer/03-function-call.c b/tests/regression/79-wrpointer/03-function-call.c index 4b3077c571..aad1060edd 100644 --- a/tests/regression/79-wrpointer/03-function-call.c +++ b/tests/regression/79-wrpointer/03-function-call.c @@ -6,9 +6,12 @@ int *i; int **j; -int *f(int **a, int *b) { - //a=...;//find tainted vars - return *a; } +int *f(int **a, int *b) { return *a; } + +int *g(int **a, int *b) { + a = (int **)malloc(sizeof(int *)); + return *a; +} int main(void) { @@ -18,5 +21,9 @@ int main(void) { __goblint_check(k == *j); + k = g(j, i); + + __goblint_check(k == *j); // UNKNOWN! + return 0; } diff --git a/tests/regression/79-wrpointer/10-different-types.c b/tests/regression/79-wrpointer/10-different-types.c index b765c5dc78..4f263d199b 100644 --- a/tests/regression/79-wrpointer/10-different-types.c +++ b/tests/regression/79-wrpointer/10-different-types.c @@ -18,21 +18,21 @@ void main(void) { // long pointer is cast to char pointer -> *(cpt + 1) overwrites *lpt long *lpt = (long *)malloc(sizeof(long)); char *cpt; - long l; - *lpt = l; + long lo; + *lpt = lo; // *lpt: 0; l: 0 - __goblint_check(*lpt == l); + __goblint_check(*lpt == lo); cpt = (char *)lpt; *(cpt + 1) = 'a'; // *lpt: 24832; l: 0 - __goblint_check(*lpt == l); // UNKNOWN! + __goblint_check(*lpt == lo); // UNKNOWN! - l = 0; - *lpt = l; + lo = 0; + *lpt = lo; // *lpt: 0; l: 0 - __goblint_check(*lpt == l); + __goblint_check(*lpt == lo); *((char *)lpt + 1) = 'a'; // *lpt: 24832; l: 0 - __goblint_check(*lpt == l); // UNKNOWN! + __goblint_check(*lpt == lo); // UNKNOWN! } diff --git a/tests/regression/79-wrpointer/13-experiments.c b/tests/regression/79-wrpointer/13-experiments.c index 3420307613..ccf22cfb44 100644 --- a/tests/regression/79-wrpointer/13-experiments.c +++ b/tests/regression/79-wrpointer/13-experiments.c @@ -27,11 +27,11 @@ void main(void) { int arr2[2][2] = {{1, 2}, {1, 2}}; p.second = arr2[1][1]; - // int *test; + int *test; - // int *x2[2] = {test, test}; + int *x2[2] = {test, test}; - // int test2 = *(x2[1]); + int test2 = *(x2[1]); struct Crazy crazyy[3][2]; From 6b2cacd26f614374340075adb864175588856e8c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 3 May 2024 16:54:59 +0200 Subject: [PATCH 097/323] first draft of join, haven't tested it yet --- src/cdomains/congruenceClosure.ml | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index a917838cdd..b9819c1105 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -645,6 +645,7 @@ module CongruenceClosure = struct let fold = TSet.fold let empty = TSet.empty let to_list = TSet.to_list + let inter = TSet.inter let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" @@ -1223,4 +1224,27 @@ module CongruenceClosure = struct (show_all old_cc) (show_all {uf; set; map; min_repr}); {uf; set; map; min_repr} + (* join *) + let join cc1 cc2 = + let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in + let pmap = List.fold_left (fun pmap a -> Map.add (a,a) a pmap) Map.empty atoms in + let working_set = List.combine atoms atoms in + let cc = init_cc [] in + let add_one_edge y t (pmap, cc) (offset, size, a) = + match LMap.map_find_opt (y, offset) size cc2.map with + | None -> pmap,cc + | Some b -> let new_term = T.deref_term t offset in + let _ , cc = insert cc new_term (*TODO find dereferenced term in the successors*) + in match Map.find_opt (a,b) pmap with + | None -> Map.add (a,b) new_term pmap, cc + | Some c -> pmap, closure cc [c, new_term, Z.zero] + in + let rec add_edges_to_map pmap cc = function + | [] -> cc, pmap + | (x,y)::rest -> + let t = Map.find (x,y) pmap in + let pmap,cc = List.fold_left (add_one_edge y t) (pmap, cc) (LMap.successors x cc1.map) in add_edges_to_map pmap cc rest + in + add_edges_to_map pmap cc working_set + end From 615453c1b1814c66b7d7bed2d32a64b9198afff8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 6 May 2024 10:45:11 +0200 Subject: [PATCH 098/323] finishe implementing join, calculate offsets correctly in join --- src/cdomains/congruenceClosure.ml | 30 ++++++++++++------- src/cdomains/weaklyRelationalPointerDomain.ml | 12 +++++++- 2 files changed, 30 insertions(+), 12 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b9819c1105..f9cb1fae27 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1227,23 +1227,31 @@ module CongruenceClosure = struct (* join *) let join cc1 cc2 = let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in - let pmap = List.fold_left (fun pmap a -> Map.add (a,a) a pmap) Map.empty atoms in + let pmap = List.fold_left + (fun pmap a -> Map.add (a,a) (a,snd (TUF.find_no_pc cc1.uf a), snd (TUF.find_no_pc cc2.uf a)) pmap) + Map.empty atoms in let working_set = List.combine atoms atoms in let cc = init_cc [] in - let add_one_edge y t (pmap, cc) (offset, size, a) = - match LMap.map_find_opt (y, offset) size cc2.map with - | None -> pmap,cc - | Some b -> let new_term = T.deref_term t offset in - let _ , cc = insert cc new_term (*TODO find dereferenced term in the successors*) - in match Map.find_opt (a,b) pmap with - | None -> Map.add (a,b) new_term pmap, cc - | Some c -> pmap, closure cc [c, new_term, Z.zero] + let add_one_edge y t t1_off t2_off (pmap, cc, new_pairs) (offset, size, a) = + let a', a_off = TUF.find_no_pc cc1.uf a in + match LMap.map_find_opt (y, Z.(t2_off - t1_off + offset)) size cc2.map with + | None -> pmap,cc,new_pairs + | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in + let new_term = T.deref_term t Z.(offset - t1_off) in + let _ , cc = insert cc new_term (*TODO find dereferenced term in the successors, because of the type/exp information*) + in match Map.find_opt (a',b') pmap with + | None -> Map.add (a',b') (new_term, a_off, b_off) pmap, cc, (a',b')::new_pairs + | Some (c, c1_off, c2_off) -> + if Z.(equal (-c1_off + a_off) (-c2_off + b_off)) then + pmap, closure cc [new_term, c, Z.(-c1_off + a_off)],new_pairs + else pmap,cc,new_pairs (* If c and new_term don't have the same distance in cc1 and cc2, we forget that they are related. *) in let rec add_edges_to_map pmap cc = function | [] -> cc, pmap | (x,y)::rest -> - let t = Map.find (x,y) pmap in - let pmap,cc = List.fold_left (add_one_edge y t) (pmap, cc) (LMap.successors x cc1.map) in add_edges_to_map pmap cc rest + let t,t1_off,t2_off = Map.find (x,y) pmap in + let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off t2_off) (pmap, cc, []) (LMap.successors x cc1.map) in + add_edges_to_map pmap cc (rest@new_pairs) in add_edges_to_map pmap cc working_set diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 61fbbc9a8e..3063d2af48 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -104,7 +104,17 @@ module D = struct let is_top = function None -> false | Some cc -> TUF.is_empty cc.uf - let join a b = if M.tracing then M.trace "wrpointer" "JOIN\n";a (*TODO implement join*) + let join a b = + let res = + match a,b with + | None, b -> b + | a, None -> a + | Some a, Some b -> Some (fst(join a b)) + in + if M.tracing then M.trace "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" + (show_all a) (show_all b) (show_all res); + res + let widen = join let meet a b = match a,b with From 5a6d17718b61ff852c660d62da7cbc3f495dbe25 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 6 May 2024 16:58:38 +0200 Subject: [PATCH 099/323] fix bug in equal --- src/cdomains/congruenceClosure.ml | 12 +++++++++++- src/cdomains/weaklyRelationalPointerDomain.ml | 3 ++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index f9cb1fae27..ce64990148 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -21,9 +21,19 @@ module T = struct (* term * size in bits of the element pointed to by the term *) type t = (Var.t, exp) term [@@deriving eq, ord, hash] - type v_prop = (Var.t, exp) prop [@@deriving eq, ord, hash] + type v_prop = (Var.t, exp) prop [@@deriving ord, hash] + + let equal_v_prop p1 p2 = + let equivalent_triple (t1,t2,o1) (t3,t4,o2) = + (equal t1 t3 && equal t2 t4 && Z.equal o1 o2) || + (equal t1 t4 && equal t2 t3 && Z.(equal o1 (-o2))) + in match p1, p2 with + | Equal (a,b,c), Equal (a',b',c') -> equivalent_triple (a,b,c) (a',b',c') + | Nequal (a,b,c), Nequal (a',b',c') -> equivalent_triple (a,b,c) (a',b',c') + | _ -> false let props_equal = List.equal equal_v_prop + let show_type exp = let typ = typeOf exp in "[" ^ (match typ with diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 3063d2af48..f01337d8a0 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -87,12 +87,13 @@ module D = struct let name () = "wrpointer" - let equal x y = if M.tracing then M.trace "wrpointer-equal" "equal.\nx=\n%s\ny=\n%s" (show x) (show y); + let equal x y = let res = match x, y with | Some x, Some y -> (T.props_equal (get_normal_form x) (get_normal_form y)) | None, None -> true | _ -> false + in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty} From 4e27d5f919aaf53bbb6d55f1f6f43cba98558be3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 7 May 2024 10:23:02 +0200 Subject: [PATCH 100/323] better dereferencing --- .../weaklyRelationalPointerAnalysis.ml | 4 +- src/cdomains/congruenceClosure.ml | 42 ++++++++++++------- 2 files changed, 29 insertions(+), 17 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 80b58aa0bf..7ddc8bf3ad 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -44,7 +44,7 @@ struct let ik = Cilfacade.get_ikind_exp e in ID.of_bool ik res end - (* TODO what is type a-> C expression, see in Queries in queries.ml -> baically its a cil expression + (* TODO Invariant. | Queries.Invariant context -> get_normal_form context*) | _ -> Result.top q @@ -120,7 +120,7 @@ struct let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in if M.tracing then M.trace "wrpointer-function" "ENTER1: state_with_assignments: %s\n" (D.show state_with_assignments); (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = (List.map (fun v -> CC.Equal (T.deref_term (CC.Addr (duplicated_variable v)) Z.zero, T.deref_term (CC.Addr v) Z.zero, Z.zero)) f.sformals) in + let added_equalities = (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities state_with_assignments in if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Disequalities.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index ce64990148..901b1288e1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -66,6 +66,9 @@ module T = struct | Addr v -> v | Deref (t, _, _) -> get_var t + let term_of_varinfo vinfo = + Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) + exception UnsupportedCilExpression of string (** Returns an integer from a cil expression and None if the expression is not an integer. *) @@ -165,6 +168,9 @@ module T = struct | (Addr v) -> AddrOf (Var v, NoOffset) | (Deref (_, _, exp)) -> exp + let show t = let res = show t in + if M.tracing then M.trace "wrpointer-show" "t: %s; exp: %a" res d_exp (to_cil t); res + let to_cil t = let exp = to_cil t in if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Exp: %a\n" (show t) d_plainexp exp; @@ -214,8 +220,6 @@ module T = struct let get_size = get_size_in_bits % type_of_term - let deref_term t z = Deref (t, z, dereference_exp (to_cil t) z) - let rec of_offset ask t off typ exp = if off = NoOffset then t else let z = z_of_offset ask off typ in @@ -656,6 +660,7 @@ module CongruenceClosure = struct let empty = TSet.empty let to_list = TSet.to_list let inter = TSet.inter + let find_opt = TSet.find_opt let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" @@ -679,6 +684,13 @@ module CongruenceClosure = struct according to our comparison function. Therefore take_while is enough. *) BatList.take_while (function Addr _ -> true | _ -> false) (elements set) + (** We try to find the dereferenced term between the already existing terms, in order to remember the information about the exp. *) + let deref_term t z set = + let exp = T.to_cil t in + match find_opt (Deref (t, z, exp)) set with + | None -> Deref (t, z, T.dereference_exp exp z) + | Some t -> t + end (** Minimal representatives map. @@ -702,7 +714,7 @@ module CongruenceClosure = struct let print_min_rep = print_string % show_min_rep - let rec update_min_repr (uf, map) min_representatives = function + let rec update_min_repr (uf, set, map) min_representatives = function | [] -> min_representatives, uf | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match LMap.successors state map with @@ -710,7 +722,7 @@ module CongruenceClosure = struct let process_edge (min_representatives, queue, uf) (edge_z, _(*min_repr is independent of the size*), next_term) = let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in - let next_min = (T.deref_term min_term Z.(edge_z - min_z), next_z) in + let next_min = (SSet.deref_term min_term Z.(edge_z - min_z) set, next_z) in match TMap.find_opt next_state min_representatives with | None -> @@ -720,7 +732,7 @@ module CongruenceClosure = struct | _ -> (min_representatives, queue, uf) in let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges - in update_min_repr (uf, map) min_representatives queue + in update_min_repr (uf, set, map) min_representatives queue (** Uses dijkstra algorithm to update the minimal representatives of the successor nodes of all edges in the queue @@ -740,11 +752,11 @@ module CongruenceClosure = struct Returns: - The map with the minimal representatives - The union find tree. This might have changed because of path compression. *) - let update_min_repr (uf, map) min_representatives queue = + let update_min_repr (uf, set, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = List.sort_unique (fun el1 el2 -> TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root uf) queue) - in update_min_repr (uf, map) min_representatives queue + in update_min_repr (uf, set, map) min_representatives queue (** Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. @@ -772,7 +784,7 @@ module CongruenceClosure = struct in let (min_representatives, queue, uf) = List.fold_left add_atom_to_map (empty, [], uf) atoms (* compute the minimal representative of all remaining edges *) - in update_min_repr (uf, map) min_representatives queue + in update_min_repr (uf, set, map) min_representatives queue (** Computes the initial map of minimal representatives. It maps each element `e` in the set to `(e, 0)`. *) @@ -825,7 +837,7 @@ module CongruenceClosure = struct List.filter_map (fun (z,s,_ (*size is not important for normal form?*),(s',z')) -> let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in - normalize_equality (T.deref_term min_state Z.(z - min_z), min_state', Z.(z' - min_z')) + normalize_equality (SSet.deref_term min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) ) transitions in BatList.sort_unique (compare_prop Var.compare (T.compare_exp)) (conjunctions_of_atoms @ conjunctions_of_transitions) @@ -944,7 +956,7 @@ module CongruenceClosure = struct *) let closure cc conjs = let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in - let min_repr, uf = MRMap.update_min_repr (uf, map) min_repr queue in + let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in {uf; set = cc.set; map; min_repr} (** Splits the conjunction into two groups: the first one contains all equality propositions, @@ -1000,7 +1012,7 @@ module CongruenceClosure = struct Returns (reference variable, offset), updated (uf, set, map, min_repr) *) let insert cc t = let v, cc, queue = insert_no_min_repr cc t in - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.map) cc.min_repr queue in + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in v, {uf; set = cc.set; map = cc.map; min_repr} (** Add all terms in a specific set to the data structure. @@ -1012,7 +1024,7 @@ module CongruenceClosure = struct | Some cc -> let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.map) cc.min_repr queue in + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in Some {uf; set = cc.set; map = cc.map; min_repr} (** Returns true if t1 and t2 are equivalent. *) @@ -1083,7 +1095,7 @@ module CongruenceClosure = struct let add_one_successor (cc, successors) (edge_z, _, _) = let _, uf_offset, uf = TUF.find cc.uf t in let cc = {cc with uf = uf} in - let successor = T.deref_term t Z.(edge_z - uf_offset) in + let successor = SSet.deref_term t Z.(edge_z - uf_offset) cc.set in let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] else insert_no_min_repr cc successor in @@ -1247,8 +1259,8 @@ module CongruenceClosure = struct match LMap.map_find_opt (y, Z.(t2_off - t1_off + offset)) size cc2.map with | None -> pmap,cc,new_pairs | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in - let new_term = T.deref_term t Z.(offset - t1_off) in - let _ , cc = insert cc new_term (*TODO find dereferenced term in the successors, because of the type/exp information*) + let new_term = SSet.deref_term t Z.(offset - t1_off) cc1.set in + let _ , cc = insert cc new_term in match Map.find_opt (a',b') pmap with | None -> Map.add (a',b') (new_term, a_off, b_off) pmap, cc, (a',b')::new_pairs | Some (c, c1_off, c2_off) -> From 40d0038fddc3ccb6f2ec2de882b9119f4bec5e2e Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 7 May 2024 10:23:24 +0200 Subject: [PATCH 101/323] added tests for join --- src/cdomains/weaklyRelationalPointerDomain.ml | 16 ++++++------ tests/regression/79-wrpointer/14-join.c | 23 ++++++++++++++++ tests/regression/79-wrpointer/16-loops.c | 26 +++++++++++++++++++ tests/regression/79-wrpointer/17-join2.c | 21 +++++++++++++++ .../79-wrpointer/18-complicated-join.c | 25 ++++++++++++++++++ 5 files changed, 103 insertions(+), 8 deletions(-) create mode 100644 tests/regression/79-wrpointer/14-join.c create mode 100644 tests/regression/79-wrpointer/16-loops.c create mode 100644 tests/regression/79-wrpointer/17-join2.c create mode 100644 tests/regression/79-wrpointer/18-complicated-join.c diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index f01337d8a0..9cf32b8e61 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -14,11 +14,11 @@ module Disequalities = struct module AD = ValueDomain.AD (*TODO: id should not clash with the other dummy values we have for function parameters*) let dummy_varinfo typ = {dummyFunDec.svar with vtype=typ} - let dummy_var var = T.deref_term (CC.Addr (dummy_varinfo var)) Z.zero + let dummy_var var = T.term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=dummyFunDec.svar.vid-1;vname="@return"} - let return_var var = T.deref_term (CC.Addr (return_varinfo var)) Z.zero + let return_var var = T.term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) (**Find out if two addresses are possibly equal by using the MayPointTo query. @@ -87,12 +87,12 @@ module D = struct let name () = "wrpointer" - let equal x y = let res = - match x, y with - | Some x, Some y -> - (T.props_equal (get_normal_form x) (get_normal_form y)) - | None, None -> true - | _ -> false + let equal x y = + let res = match x, y with + | Some x, Some y -> + (T.props_equal (get_normal_form x) (get_normal_form y)) + | None, None -> true + | _ -> false in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty} diff --git a/tests/regression/79-wrpointer/14-join.c b/tests/regression/79-wrpointer/14-join.c new file mode 100644 index 0000000000..45afe38386 --- /dev/null +++ b/tests/regression/79-wrpointer/14-join.c @@ -0,0 +1,23 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState + +#include + +void main(void) { + long y; + long i; + long x; + long *z; + int top; + + if (top) { + z = -1 + &x; + y = x; + } else { + z = -1 + &x; + i = x; + } + + __goblint_check(z == -1 + &x); + __goblint_check(x == i); // UNKNOWN! + __goblint_check(y == x); // UNKNOWN! +} diff --git a/tests/regression/79-wrpointer/16-loops.c b/tests/regression/79-wrpointer/16-loops.c new file mode 100644 index 0000000000..c8315c5b22 --- /dev/null +++ b/tests/regression/79-wrpointer/16-loops.c @@ -0,0 +1,26 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState + +#include +#include + +void main(void) { + long y; + long i; + long x; + long *z; + int top; + + y = x; + z = -1 + &x; + + while (top) { + int top2; + z = (long*)malloc(sizeof(long)); + z = -1 + &x; + y++; + top = top2; + } + + __goblint_check(z == -1 + &x); + __goblint_check(y == x); // UNKNOWN! +} diff --git a/tests/regression/79-wrpointer/17-join2.c b/tests/regression/79-wrpointer/17-join2.c new file mode 100644 index 0000000000..bb1bfbea8f --- /dev/null +++ b/tests/regression/79-wrpointer/17-join2.c @@ -0,0 +1,21 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState + +#include + +void main(void) { + long *y = (long *)malloc(4 * sizeof(long)); + long a; + long b; + long *x = (long *)malloc(4 * sizeof(long)); + int top; + + if (top) { + *(x + 2) = a + 1; + *(y + 1) = a + 2; + } else { + *(x + 2) = b + 2; + *(y + 1) = b + 3; + } + + __goblint_check(*(x + 2) == *(y + 1) - 1); +} diff --git a/tests/regression/79-wrpointer/18-complicated-join.c b/tests/regression/79-wrpointer/18-complicated-join.c new file mode 100644 index 0000000000..8006387247 --- /dev/null +++ b/tests/regression/79-wrpointer/18-complicated-join.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// Example 1 from the paper Join Algorithms for the Theory of Uninterpreted +// Functions by Gulwani et al. + +#include +#include + +void main(void) { + long ********y = (long ********)malloc(100 * sizeof(long *)); + *y = (long *******)malloc(100 * sizeof(long *)); + **y = (long ******)malloc(100 * sizeof(long *)); + int top; + + if (top) { + **y = (long ******)y; + __goblint_check(**y == (long ******)y); + __goblint_check(******y == (long**)y); + } else { + ***y = (long ***)y; + __goblint_check(***y == (long *****)y); + __goblint_check(******y == (long**)y); + } + + __goblint_check(******y == (long**)y); +} From 4216b06456bc75e4532e4dff1ee97b7651b1612c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 7 May 2024 16:02:36 +0200 Subject: [PATCH 102/323] implemented disequalities --- .../weaklyRelationalPointerAnalysis.ml | 14 +- src/cdomains/congruenceClosure.ml | 225 ++++++++++++++++-- src/cdomains/weaklyRelationalPointerDomain.ml | 6 +- .../79-wrpointer/19-disequalities.c | 20 ++ 4 files changed, 235 insertions(+), 30 deletions(-) create mode 100644 tests/regression/79-wrpointer/19-disequalities.c diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 7ddc8bf3ad..3c5577c1c1 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -55,7 +55,7 @@ struct | lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t (* Definite assignment *) | lterm, (Some term, Some offset) -> - let dummy_var = Disequalities.dummy_var (typeOfLval lval) in + let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> @@ -94,9 +94,9 @@ struct let return ctx exp_opt f = let res = match exp_opt with | Some e -> - assign_return (ask_of_ctx ctx) ctx.local (Disequalities.return_var (typeOf e)) e + assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e | None -> ctx.local - in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (Disequalities.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res + in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in @@ -122,7 +122,7 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities state_with_assignments in - if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Disequalities.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals (*@ all globals*) in @@ -135,16 +135,16 @@ struct let combine_env ctx var_opt expr f exprs t_context_opt t ask = let og_t = t in let t = D.meet ctx.local t in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (Disequalities.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t - | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var (Disequalities.return_lval (typeOfLval var)) + | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var (MayBeEqual.return_lval (typeOfLval var)) in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in let t = - D.remove_terms_containing_variables (Disequalities.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t + D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t (*ctx.local is after combine_env, t callee*) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 901b1288e1..9fd0870ba5 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -537,14 +537,14 @@ module UnionFind = struct end +module ZMap = struct + include Map.Make(Z) + let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 +end + (** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a set containing all terms in the data structure that are equal to *(z + t').*) module LookupMap = struct - module ZMap = struct - include Map.Make(Z) - let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 - end - (* map: term -> z -> size of typ -> *(z + (typ * )t)*) type t = TSet.t ZMap.t ZMap.t TMap.t [@@deriving eq, ord, hash] @@ -649,6 +649,171 @@ module CongruenceClosure = struct module TUF = UnionFind module LMap = LookupMap + module Disequalities = struct + + type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) + type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) + + let empty = TMap.empty + + (** adds a mapping v -> r -> {v'} to the map, or if there are already elements + in v -> r -> {..} then v* is added to the previous set *) + let map_set_add (v,r) v' map = match TMap.find_opt v map with + | None -> TMap.add v (ZMap.add r (TSet.singleton v') ZMap.empty) map + | Some imap -> TMap.add v ( + match ZMap.find_opt r imap with + | None -> ZMap.add r (TSet.singleton v') imap + | Some set -> ZMap.add r (TSet.add v' set) imap) map + + let map_set_mem (v,r) v' map = match TMap.find_opt v map with + | None -> false + | Some imap -> (match ZMap.find_opt r imap with + | None -> false + | Some set -> TSet.mem v' set + ) + + (** used by NEQ and EQ + + map of partition, transform union find to a map + of type V -> Z -> V set + with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset *) + let comp_map part = List.fold_left (fun comp (v,_) -> + map_set_add (TUF.find_no_pc part v) v comp) + TMap.empty (TMap.bindings part) + + (** arg: + + maps each representative term t to a map that maps an integer Z to + a list of representatives t' of v where *(v + z') is + in the representative class of t. + + It basically maps each state in the automata to its predecessors. *) + let get_args part = + let cmap = comp_map part in + let clist = TMap.bindings cmap in + let arg = List.fold_left (fun arg (v, imap) -> + let ilist = ZMap.bindings imap in + let iarg = List.fold_left (fun iarg (r,set) -> + let list = List.filter_map (function + | Deref (v',r',_) -> + let (v0,r0) = TUF.find_no_pc part v' in + Some (v0,Z.(r0+r')) + | _ -> None) (TSet.elements set) in + ZMap.add r list iarg) ZMap.empty ilist in + TMap.add v iarg arg) TMap.empty clist in + (part,cmap,arg) + + let fold_left2 f acc l1 l2 = + List.fold_left ( + fun acc x -> List.fold_left ( + fun acc y -> f acc x y) acc l2) acc l1 + + let map2 f l1 l2 = List.concat ( + List.map (fun x -> + List.map (fun y -> f x y) l2) l1) + + let map_find_opt (v,r) map = match TMap.find_opt v map with + | None -> None + | Some imap -> (match ZMap.find_opt r imap with + | None -> None + | Some v -> Some v + ) + + let check_neq (_,arg) rest (v,imap) = + let ilist = ZMap.bindings imap in + fold_left2 (fun rest (r1,_) (r2,_) -> + if Z.equal r1 r2 then rest + else (* r1 <> r2 *) + let l1 = match map_find_opt (v,r1) arg + with None -> [] + | Some list -> list in + (* just take the elements of set1 ? *) + let l2 = match map_find_opt (v,r2) arg + with None -> [] + | Some list -> list in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if v1 = v2 then if r'1 = r'2 + then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 + ) rest ilist ilist + + (** used by NEQ *) + let init_neq (part,cmap,arg) = (* list of non-trivially implied dis-equalities *) + List.fold_left (check_neq (part,arg)) [] (TMap.bindings cmap) + + (** used by NEQ *) + let init_list_neq (part,_,_) neg = (* list of normalized provided dis-equalities *) + List.filter_map (fun (v1,v2,r) -> + let (v1,r1) = TUF.find_no_pc part v1 in + let (v2,r2) = TUF.find_no_pc part v2 in + if T.compare v1 v2 = 0 then if r1 = Z.(r2+r) then raise Unsat + else None + else Some (v1,v2,Z.(r2-r1+r))) neg + + (** used by NEQ *) + let rec propagate_neq (part,cmap,arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) + | [] -> neq (* part need not be returns: has been flattened during constr. of cmap *) + | (v1,v2,r) :: rest -> (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) + if T.equal v1 v2 then (* should not happen *) + if Z.equal r Z.zero then raise Unsat else propagate_neq (part,cmap,arg,neq) rest + else (* check whether it is already in neq *) + if map_set_mem (v1,r) v2 neq then propagate_neq (part,cmap,arg,neq) rest + else let neq = map_set_add (v1,Z.(-r)) v2 neq |> + map_set_add (v2,r) v1 in + (* + search components of v1, v2 for elements at distance r to obtain inferred equalities + at the same level (not recorded) and then compare their predecessors + *) + match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with + | None,_ | _,None -> raise (Failure "empty component?") + | Some imap1, Some imap2 -> + let ilist1 = ZMap.bindings imap1 in + let rest = List.fold_left (fun rest (r1,_) -> + match ZMap.find_opt Z.(r1-r) imap2 with + | None -> rest + | Some _ -> + let l1 = match map_find_opt (v1,r1) arg + with None -> [] + | Some list -> list in + let l2 = match map_find_opt (v2,Z.(r1-r)) arg + with None -> [] + | Some list -> list in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if v1 = v2 then if r'1 = r'2 then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2) + rest ilist1 in + propagate_neq (part,cmap,arg,neq) rest + + (* + collection of disequalities: + * disequalities originating from different offsets of same root + * stated disequalities + * closure by collecting appropriate args + for a disequality v1 != v2 +r for distinct roots v1,v2 + check whether there is some r1, r2 such that r1 = r2 +r + then dis-equate the sets at v1,r1 with v2,r2. + *) + + let print_neq neq = + let clist = TMap.bindings neq in + List.iter (fun (v,imap) -> + let ilist = ZMap.bindings imap in + List.iter (fun (r,set) -> + let list = TSet.elements set in + List.iter (fun v' -> + print_string "\t"; + print_string (T.show v'); + print_string " != "; + (if r = Z.zero then () else + print_string (Z.to_string r); + print_string " + "); + print_string (T.show v); + print_string "\n") list) ilist) clist + + end + (** Set of subterms which are present in the current data structure. *) module SSet = struct type t = TSet.t [@@deriving eq, ord, hash] @@ -795,7 +960,8 @@ module CongruenceClosure = struct type t = {uf: TUF.t; set: SSet.t; map: LMap.t; - min_repr: MRMap.t} + min_repr: MRMap.t; + diseq: Disequalities.t} [@@deriving eq, ord, hash] let string_of_prop = function @@ -868,7 +1034,7 @@ module CongruenceClosure = struct let uf = SSet.elements set |> TUF.init in let min_repr = MRMap.initial_minimal_representatives set in - {uf; set; map; min_repr} + {uf; set; map; min_repr; diseq = Disequalities.empty} (** parameters: (uf, map) equalities. @@ -957,7 +1123,7 @@ module CongruenceClosure = struct let closure cc conjs = let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in - {uf; set = cc.set; map; min_repr} + {uf; set = cc.set; map; min_repr; diseq = cc.diseq} (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) @@ -994,7 +1160,7 @@ module CongruenceClosure = struct | Addr a -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), {uf; set; map = cc.map; min_repr}, [Addr a] + (t, Z.zero), {uf; set; map = cc.map; min_repr; diseq = cc.diseq}, [Addr a] | Deref (t', z, exp) -> let (v, r), cc, queue = insert_no_min_repr cc t' in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in @@ -1002,10 +1168,10 @@ module CongruenceClosure = struct match LMap.map_find_opt (v, Z.(r + z)) (T.get_size_in_bits (typeOf exp)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr} [(t, v', Z.zero)], v::queue + (v2,z2), closure {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq} [(t, v', Z.zero)], v::queue | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), {uf; set; map; min_repr}, v::queue + (t, Z.zero), {uf; set; map; min_repr; diseq = cc.diseq}, v::queue (** Add a term to the data structure. @@ -1013,7 +1179,7 @@ module CongruenceClosure = struct let insert cc t = let v, cc, queue = insert_no_min_repr cc t in let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - v, {uf; set = cc.set; map = cc.map; min_repr} + v, {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} (** Add all terms in a specific set to the data structure. @@ -1025,7 +1191,23 @@ module CongruenceClosure = struct let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in (* update min_repr at the end for more efficiency *) let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - Some {uf; set = cc.set; map = cc.map; min_repr} + Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} + + + (** used by NEQ *) + let congruence_neq cc neg = + match insert_set_opt (Some cc) (fst (SSet.subterms_of_conj neg)) with + | None -> None + | Some cc -> + (* getting args of dereferences *) + let uf,cmap,arg = Disequalities.get_args cc.uf in + (* taking implicit dis-equalities into account *) + let neq_list = Disequalities.init_neq (uf,cmap,arg) in + let neq = Disequalities.propagate_neq (uf,cmap,arg,TMap.empty) neq_list in + (* taking explicit dis-equalities into account *) + let neq_list = Disequalities.init_list_neq (uf,cmap,arg) neg in + let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in + Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq} (** Returns true if t1 and t2 are equivalent. *) let eq_query cc (t1,t2,r) = @@ -1045,7 +1227,7 @@ module CongruenceClosure = struct if T.equal v1 v2 then if Z.(equal r1 (r2 + r)) then false else true - else false + else Disequalities.map_set_mem (v1,Z.(r2-r1+r)) v2 cc.diseq (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = @@ -1054,10 +1236,13 @@ module CongruenceClosure = struct let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs = split conjs in - if List.exists (fun c -> eq_query_opt cc c) neg_conjs then None else - match meet_conjs cc pos_conjs with - | exception Unsat -> None - | t -> t + match meet_conjs cc pos_conjs with + | exception Unsat -> None + | Some cc -> begin match congruence_neq cc neg_conjs with + | exception Unsat -> None + | cc -> cc + end + | None -> None (** Add proposition t1 = t2 + r to the data structure. *) let add_eq cc (t1, t2, r) = @@ -1243,8 +1428,8 @@ module CongruenceClosure = struct remove_terms_from_map (uf, map) removed_terms new_parents_map in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all old_cc) (show_all {uf; set; map; min_repr}); - {uf; set; map; min_repr} + (show_all old_cc) (show_all {uf; set; map; min_repr; diseq = cc.diseq}); + {uf; set; map; min_repr; diseq = cc.diseq} (* join *) let join cc1 cc2 = diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 9cf32b8e61..59a813189e 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -9,7 +9,7 @@ module M = Messages module T = CC.T (**Find out if two addresses are not equal by using the MayPointTo query*) -module Disequalities = struct +module MayBeEqual = struct module AD = ValueDomain.AD (*TODO: id should not clash with the other dummy values we have for function parameters*) @@ -95,7 +95,7 @@ module D = struct | _ -> false in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty} + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty} let init () = init_congruence [] @@ -167,6 +167,6 @@ module D = struct let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = Option.map (fun cc -> (snd(insert cc term))) cc in - Option.map (remove_terms (fun uf -> Disequalities.may_be_equal ask uf s term)) cc + Option.map (remove_terms (fun uf -> MayBeEqual.may_be_equal ask uf s term)) cc end diff --git a/tests/regression/79-wrpointer/19-disequalities.c b/tests/regression/79-wrpointer/19-disequalities.c new file mode 100644 index 0000000000..76a33353e9 --- /dev/null +++ b/tests/regression/79-wrpointer/19-disequalities.c @@ -0,0 +1,20 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +#include +#include + +void main(void) { + int *i; + int **j; + j = (int **)malloc(sizeof(int *) + 7); + *(j + 3) = (int *)malloc(sizeof(int)); + int *k; + *j = k; + + __goblint_check(**j != *k + 1); + __goblint_check(**j != *k + 2); + + if (*i != **(j + 3)) { + __goblint_check(i != *(j + 3)); + __goblint_check(&i != j + 3); + } +} From d34c252b7870506a43a31ec9c4fbd2b3b3cd5aec Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 9 May 2024 16:51:35 +0200 Subject: [PATCH 103/323] implemented remove with disequalities --- src/cdomains/congruenceClosure.ml | 161 +++++++++++++----- src/cdomains/weaklyRelationalPointerDomain.ml | 3 +- 2 files changed, 117 insertions(+), 47 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9fd0870ba5..0b167a0c21 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -29,9 +29,12 @@ module T = struct (equal t1 t4 && equal t2 t3 && Z.(equal o1 (-o2))) in match p1, p2 with | Equal (a,b,c), Equal (a',b',c') -> equivalent_triple (a,b,c) (a',b',c') - | Nequal (a,b,c), Nequal (a',b',c') -> equivalent_triple (a,b,c) (a',b',c') + | Nequal (a,b,c), Nequal (a',b',c') -> equivalent_triple (a,b,c) (a',b',c') | _ -> false + let compare_v_prop p1 p2 = + if equal_v_prop p1 p2 then 0 else compare_v_prop p1 p2 + let props_equal = List.equal equal_v_prop let show_type exp = @@ -651,36 +654,56 @@ module CongruenceClosure = struct module Disequalities = struct - type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) + (* map: term -> z -> size of typ -> *(z + (typ * )t)*) + type t = TSet.t ZMap.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) let empty = TMap.empty - - (** adds a mapping v -> r -> {v'} to the map, or if there are already elements - in v -> r -> {..} then v* is added to the previous set *) - let map_set_add (v,r) v' map = match TMap.find_opt v map with - | None -> TMap.add v (ZMap.add r (TSet.singleton v') ZMap.empty) map - | Some imap -> TMap.add v ( - match ZMap.find_opt r imap with - | None -> ZMap.add r (TSet.singleton v') imap - | Some set -> ZMap.add r (TSet.add v' set) imap) map + let remove = TMap.remove + let bindings = + List.flatten % + List.flatten % + List.flatten % + List.map (fun (t, zmap) -> + List.map (fun (z, smap) -> + List.map (fun (size, tset) -> + List.map (fun term -> + (t,z,size,term)) (TSet.elements tset)) + (ZMap.bindings smap) + ) (ZMap.bindings zmap) + ) % TMap.bindings + + (** adds a mapping v -> r -> size -> {v'} to the map, or if there are already elements + in v -> r -> {..} then v* is added to the previous set *) + let map_set_add = LMap.map_add + let shift = LMap.shift let map_set_mem (v,r) v' map = match TMap.find_opt v map with | None -> false | Some imap -> (match ZMap.find_opt r imap with | None -> false - | Some set -> TSet.mem v' set + | Some imap -> + (let size = (T.get_size v') in + match ZMap.find_opt size imap with + | None -> false + | Some set -> TSet.mem v' set + ) ) - (** used by NEQ and EQ - - map of partition, transform union find to a map + (** Map of partition, transform union find to a map of type V -> Z -> V set - with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset *) + with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) let comp_map part = List.fold_left (fun comp (v,_) -> map_set_add (TUF.find_no_pc part v) v comp) TMap.empty (TMap.bindings part) + let flatten_map = + ZMap.map (fun zmap -> List.fold_left + (fun set (_,mapped) -> TSet.union set mapped) TSet.empty (ZMap.bindings zmap)) + + let flatten_args = + ZMap.map (fun zmap -> List.fold_left + (fun set (_,mapped) -> set @ mapped) [] (ZMap.bindings zmap)) (** arg: maps each representative term t to a map that maps an integer Z to @@ -693,14 +716,22 @@ module CongruenceClosure = struct let clist = TMap.bindings cmap in let arg = List.fold_left (fun arg (v, imap) -> let ilist = ZMap.bindings imap in - let iarg = List.fold_left (fun iarg (r,set) -> - let list = List.filter_map (function - | Deref (v',r',_) -> - let (v0,r0) = TUF.find_no_pc part v' in - Some (v0,Z.(r0+r')) - | _ -> None) (TSet.elements set) in - ZMap.add r list iarg) ZMap.empty ilist in - TMap.add v iarg arg) TMap.empty clist in + let imap_sizes = flatten_args (List.fold_left + (fun imap_sizes (size, map) + -> + let iarg = List.fold_left (fun iarg (r,set) -> + let list = List.filter_map (function + | Deref (v',r',_) -> + let (v0,r0) = TUF.find_no_pc part v' in + Some (v0,Z.(r0+r')) + | _ -> None) (TSet.elements set) in + ZMap.add r list iarg + ) + ZMap.empty (ZMap.bindings map) in + ZMap.add size iarg imap_sizes) + ZMap.empty ilist) in + TMap.add v imap_sizes arg) + TMap.empty clist in (part,cmap,arg) let fold_left2 f acc l1 l2 = @@ -719,7 +750,8 @@ module CongruenceClosure = struct | Some v -> Some v ) - let check_neq (_,arg) rest (v,imap) = + let check_neq (_,arg) rest (v,imapmap) = + let imap = flatten_map imapmap in let ilist = ZMap.bindings imap in fold_left2 (fun rest (r1,_) (r2,_) -> if Z.equal r1 r2 then rest @@ -732,7 +764,7 @@ module CongruenceClosure = struct with None -> [] | Some list -> list in fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if v1 = v2 then if r'1 = r'2 + if T.equal v1 v2 then if Z.equal r'1 r'2 then raise Unsat else rest else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 @@ -751,9 +783,12 @@ module CongruenceClosure = struct else None else Some (v1,v2,Z.(r2-r1+r))) neg - (** used by NEQ *) + (** Parameter: list of disequalities (t1, t2, z), where t1 and t2 are roots. + + Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. + *) let rec propagate_neq (part,cmap,arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) - | [] -> neq (* part need not be returns: has been flattened during constr. of cmap *) + | [] -> neq (* part need not be returned: has been flattened during constr. of cmap *) | (v1,v2,r) :: rest -> (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) if T.equal v1 v2 then (* should not happen *) if Z.equal r Z.zero then raise Unsat else propagate_neq (part,cmap,arg,neq) rest @@ -796,21 +831,32 @@ module CongruenceClosure = struct then dis-equate the sets at v1,r1 with v2,r2. *) - let print_neq neq = + let show_neq neq = let clist = TMap.bindings neq in - List.iter (fun (v,imap) -> - let ilist = ZMap.bindings imap in - List.iter (fun (r,set) -> - let list = TSet.elements set in - List.iter (fun v' -> - print_string "\t"; - print_string (T.show v'); - print_string " != "; - (if r = Z.zero then () else - print_string (Z.to_string r); - print_string " + "); - print_string (T.show v); - print_string "\n") list) ilist) clist + List.fold_left (fun s (v,imap) -> + s ^ let ilist = ZMap.bindings imap in + List.fold_left (fun s (r,map) -> + s ^ let slist = ZMap.bindings map in + List.fold_left + (fun s (size,set) -> + s ^ let list = TSet.elements set in + List.fold_left + (fun s v' -> + s ^ "\t" ^ T.show v' ^ " != "^ + (if r = Z.zero then "" else + (Z.to_string r) ^" + ") + ^ T.show v ^ "\n") "" list)"" slist) + "" ilist) "" clist + let filter_map f (diseq:t) = + TMap.filter_map + (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) + zmap in if ZMap.is_empty zmap then None else Some zmap) + zmap in if ZMap.is_empty zmap then None else Some zmap) diseq end @@ -1004,8 +1050,13 @@ module CongruenceClosure = struct let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in normalize_equality (SSet.deref_term min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) - ) transitions - in BatList.sort_unique (compare_prop Var.compare (T.compare_exp)) (conjunctions_of_atoms @ conjunctions_of_transitions) + ) transitions in + (*disequalities*) + let disequalities = List.map + (fun (t1, z, _, t2) -> + Nequal (t1,t2,z) + ) @@ Disequalities.bindings cc.diseq + in BatList.sort_unique (T.compare_v_prop)(conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities) let show_all x = "Normal form:\n" ^ show_conj((get_normal_form x)) ^ @@ -1017,6 +1068,8 @@ module CongruenceClosure = struct ^ (LMap.show_map x.map) ^ "\nMinimal representatives:\n" ^ (MRMap.show_min_rep x.min_repr) + ^ "\nNeq:\n" + ^ (Disequalities.show_neq x.diseq) (** returns {uf, set, map, min_repr}, where: @@ -1401,7 +1454,7 @@ module CongruenceClosure = struct LMap.filter_if map (not % predicate) (** For all the elements in the removed terms set, it moves the mapped value to the new root. - Returns new map and new union-find*) + Returns new map and new union-find. *) let remove_terms_from_map (uf, map) removed_terms new_parents_map = let remove_from_map (map, uf) term = match LMap.find_opt term map with @@ -1412,6 +1465,20 @@ module CongruenceClosure = struct | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term map, uf in List.fold_left remove_from_map (map, uf) removed_terms + let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms new_parents_map uf = + (* modify mapped values *) + let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) diseq in + (* modify left hand side of map *) + let remove_from_diseq diseq term = + match LMap.find_opt term diseq with + | None -> diseq + | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) + match find_new_root new_parents_map uf term with + | None -> Disequalities.remove term diseq + | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term diseq + in List.fold_left remove_from_diseq diseq removed_terms + + (** Remove terms from the data structure. It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) @@ -1426,9 +1493,11 @@ module CongruenceClosure = struct remove_terms_from_mapped_values cc.map (predicate cc.uf) in let map, uf = remove_terms_from_map (uf, map) removed_terms new_parents_map + in let diseq = + remove_terms_from_diseq cc.diseq removed_terms new_parents_map uf in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all old_cc) (show_all {uf; set; map; min_repr; diseq = cc.diseq}); + (show_all old_cc) (show_all {uf; set; map; min_repr; diseq}); {uf; set; map; min_repr; diseq = cc.diseq} (* join *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 59a813189e..2a05ea8336 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -133,12 +133,13 @@ module D = struct let printXml f x = match x with | Some x -> - BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\n\n" + BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) + (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) | None -> BatPrintf.fprintf f "\nbottom\n\n" (** Remove terms from the data structure. From b5e94a9fdede4bba7be215336a94374f3654eb19 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 9 May 2024 17:25:25 +0200 Subject: [PATCH 104/323] only dereference disequalities if they have the same size --- src/cdomains/congruenceClosure.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 0b167a0c21..fcfd607e69 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -817,7 +817,9 @@ module CongruenceClosure = struct fold_left2 (fun rest (v1,r'1) (v2,r'2) -> if v1 = v2 then if r'1 = r'2 then raise Unsat else rest - else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2) + (* disequalities propagate only if the terms have same size*) + else if Z.equal (T.get_size v1) (T.get_size v2) then + (v1,v2,Z.(r'2-r'1))::rest else rest ) rest l1 l2) rest ilist1 in propagate_neq (part,cmap,arg,neq) rest @@ -1465,9 +1467,9 @@ module CongruenceClosure = struct | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term map, uf in List.fold_left remove_from_map (map, uf) removed_terms - let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms new_parents_map uf = + let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms predicate new_parents_map uf = (* modify mapped values *) - let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) diseq in + let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (LMap.filter_if diseq (not % predicate)) in (* modify left hand side of map *) let remove_from_diseq diseq term = match LMap.find_opt term diseq with @@ -1494,7 +1496,7 @@ module CongruenceClosure = struct in let map, uf = remove_terms_from_map (uf, map) removed_terms new_parents_map in let diseq = - remove_terms_from_diseq cc.diseq removed_terms new_parents_map uf + remove_terms_from_diseq cc.diseq removed_terms (predicate cc.uf) new_parents_map uf in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) (show_all old_cc) (show_all {uf; set; map; min_repr; diseq}); From 1fa4e660cb6a97562036c135c262920825effd8b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 9 May 2024 17:25:42 +0200 Subject: [PATCH 105/323] add test for disequalities --- .../79-wrpointer/19-disequalities.c | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/regression/79-wrpointer/19-disequalities.c b/tests/regression/79-wrpointer/19-disequalities.c index 76a33353e9..3d240a087c 100644 --- a/tests/regression/79-wrpointer/19-disequalities.c +++ b/tests/regression/79-wrpointer/19-disequalities.c @@ -16,5 +16,25 @@ void main(void) { if (*i != **(j + 3)) { __goblint_check(i != *(j + 3)); __goblint_check(&i != j + 3); + j = NULL; + __goblint_check(i != *(j + 3)); // UNKNOWN + } + + int *k2 = (int *)malloc(sizeof(int)); + *j = k2; + k = k2; + + __goblint_check(*j == k); + __goblint_check(k2 == k); + + int *f1 = (int *)malloc(sizeof(int)); + int *f2 = f2; + + if (*j != f2) { + __goblint_check(*j != f2); + __goblint_check(k != f1); + j = NULL; + __goblint_check(*j != f2); // UNKNOWN + __goblint_check(k != f1); } } From 4da20a653d1ea24dd640a3adca45bd5d4c138588 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 9 May 2024 18:20:43 +0200 Subject: [PATCH 106/323] implemented join for disequalities --- src/cdomains/congruenceClosure.ml | 61 +++++++++++++------ src/cdomains/weaklyRelationalPointerDomain.ml | 3 +- tests/regression/79-wrpointer/22-join-diseq.c | 37 +++++++++++ 3 files changed, 81 insertions(+), 20 deletions(-) create mode 100644 tests/regression/79-wrpointer/22-join-diseq.c diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index fcfd607e69..a2e4a9728a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -860,6 +860,17 @@ module CongruenceClosure = struct zmap in if ZMap.is_empty zmap then None else Some zmap) zmap in if ZMap.is_empty zmap then None else Some zmap) diseq + let get_disequalities = List.map + (fun (t1, z, _, t2) -> + Nequal (t1,t2,z) + ) % bindings + + let intersect cmap1 cmap2 = + List.fold_left (fun result_map (t1, z, size, t2) -> + if map_set_mem (t1,z) t2 cmap2 then + map_set_add (t1,z) t2 result_map + else result_map) TMap.empty + (bindings cmap1) end (** Set of subterms which are present in the current data structure. *) @@ -874,6 +885,7 @@ module CongruenceClosure = struct let to_list = TSet.to_list let inter = TSet.inter let find_opt = TSet.find_opt + let union = TSet.union let show_set set = TSet.fold (fun v s -> s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" @@ -1054,10 +1066,7 @@ module CongruenceClosure = struct normalize_equality (SSet.deref_term min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) ) transitions in (*disequalities*) - let disequalities = List.map - (fun (t1, z, _, t2) -> - Nequal (t1,t2,z) - ) @@ Disequalities.bindings cc.diseq + let disequalities = Disequalities.get_disequalities cc.diseq in BatList.sort_unique (T.compare_v_prop)(conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities) let show_all x = "Normal form:\n" ^ @@ -1253,16 +1262,17 @@ module CongruenceClosure = struct let congruence_neq cc neg = match insert_set_opt (Some cc) (fst (SSet.subterms_of_conj neg)) with | None -> None - | Some cc -> - (* getting args of dereferences *) - let uf,cmap,arg = Disequalities.get_args cc.uf in - (* taking implicit dis-equalities into account *) - let neq_list = Disequalities.init_neq (uf,cmap,arg) in - let neq = Disequalities.propagate_neq (uf,cmap,arg,TMap.empty) neq_list in - (* taking explicit dis-equalities into account *) - let neq_list = Disequalities.init_list_neq (uf,cmap,arg) neg in - let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in - Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq} + | Some cc -> try + (* getting args of dereferences *) + let uf,cmap,arg = Disequalities.get_args cc.uf in + (* taking implicit dis-equalities into account *) + let neq_list = Disequalities.init_neq (uf,cmap,arg) in + let neq = Disequalities.propagate_neq (uf,cmap,arg,cc.diseq) neq_list in + (* taking explicit dis-equalities into account *) + let neq_list = Disequalities.init_list_neq (uf,cmap,arg) neg in + let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in + Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq} + with Unsat -> None (** Returns true if t1 and t2 are equivalent. *) let eq_query cc (t1,t2,r) = @@ -1293,10 +1303,7 @@ module CongruenceClosure = struct let pos_conjs, neg_conjs = split conjs in match meet_conjs cc pos_conjs with | exception Unsat -> None - | Some cc -> begin match congruence_neq cc neg_conjs with - | exception Unsat -> None - | cc -> cc - end + | Some cc -> congruence_neq cc neg_conjs | None -> None (** Add proposition t1 = t2 + r to the data structure. *) @@ -1503,7 +1510,7 @@ module CongruenceClosure = struct {uf; set; map; min_repr; diseq = cc.diseq} (* join *) - let join cc1 cc2 = + let join_eq cc1 cc2 = let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in let pmap = List.fold_left (fun pmap a -> Map.add (a,a) (a,snd (TUF.find_no_pc cc1.uf a), snd (TUF.find_no_pc cc2.uf a)) pmap) @@ -1533,4 +1540,20 @@ module CongruenceClosure = struct in add_edges_to_map pmap cc working_set + (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) + let join_neq diseq1 diseq2 cc = + let _,diseq1 = split (Disequalities.get_disequalities diseq1) in + let _,diseq2 = split (Disequalities.get_disequalities diseq2) in + let cc = insert_set_opt (Some cc) (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2)) in + begin match cc with + | None -> None + | Some cc -> + begin match congruence_neq cc diseq1, congruence_neq cc diseq2 with + | None, cc | cc, None -> cc + | Some cc1, Some cc2 -> Some {cc1 with diseq=Disequalities.intersect cc1.diseq cc2.diseq} + end + end + + + end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 2a05ea8336..9c43aee459 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -110,7 +110,8 @@ module D = struct match a,b with | None, b -> b | a, None -> a - | Some a, Some b -> Some (fst(join a b)) + | Some a, Some b -> let cc = fst(join_eq a b) + in join_neq a.diseq b.diseq cc in if M.tracing then M.trace "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" (show_all a) (show_all b) (show_all res); diff --git a/tests/regression/79-wrpointer/22-join-diseq.c b/tests/regression/79-wrpointer/22-join-diseq.c new file mode 100644 index 0000000000..ffcfe15f3f --- /dev/null +++ b/tests/regression/79-wrpointer/22-join-diseq.c @@ -0,0 +1,37 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState + +#include + +void main(void) { + long *a; + long *b; + long *c; + long *d = (long *)malloc(4 * sizeof(long)); + long *e = (long *)malloc(4 * sizeof(long)); + + long *unknown; + + int top; + + if (a != b && e != c && c != d) { + __goblint_check(a != b); + __goblint_check(e != c); + __goblint_check(c != d); + if (top) { + d = unknown; + __goblint_check(a != b); + __goblint_check(e != c); + __goblint_check(c != d); // UNKNOWN! + + } else { + e = unknown; + __goblint_check(a != b); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); + } + // JOIN + __goblint_check(a != b); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); // UNKNOWN! + } +} From ad80a1925dfb8f57c43adf6c39fec59ee10bcd31 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 13 May 2024 12:12:19 +0200 Subject: [PATCH 107/323] fixed bugs in startState analysis and remembered tainted variables in return of startState --- src/analyses/startStateAnalysis.ml | 36 +++++++++++++++++------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index a1bd5e2b1f..5ab70e725b 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -1,4 +1,4 @@ -(** Remebers the Value of each parameter at the beginning of each function. +(** Remembers the Value of each parameter at the beginning of each function. Used by the wrpointer anaylysis. *) open GoblintCil @@ -21,30 +21,35 @@ struct include Analyses.IdentitySpec - let duplicated_variable var = { var with vid = - var.vid; vname = var.vname ^ "'" } - let original_variable var = { var with vid = - var.vid; vname = String.rchop var.vname } + let duplicated_variable var = { var with vid = - var.vid - 4; vname = var.vname ^ "'" } + let original_variable var = { var with vid = - (var.vid + 4); vname = String.rchop var.vname } + let return_varinfo = {dummyFunDec.svar with vid=(-2);vname="@return"} let get_value (ask: Queries.ask) exp = ask.f (MayPointTo exp) (** If e is a known variable, then it returns the value for this variable. If e is an unknown variable, then it returns bot. - If e is another expression that is not simply a ariable, then it returns top. *) + If e is another expression that is not simply a variable, then it returns top. *) let eval (ask: Queries.ask) (d: D.t) (exp: exp): Value.t = match exp with | Lval (Var x, NoOffset) -> begin match D.find_opt x d with - | Some v -> v + | Some v -> if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v | None -> Value.top() end - | AddrOf (Var x, NoOffset) -> if x.vid < 0 then get_value ask (AddrOf (Var (original_variable x), NoOffset)) else Value.top() + | AddrOf (Var x, NoOffset) -> if x.vid < -1 then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty res;res) else Value.top() | _ -> Value.top () let startstate v = D.bot () let exitstate = startstate let return ctx exp_opt f = - (*remember all value of local vars*) - List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in - if M.tracing then M.trace "startState" "return: added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; - D.add (var) value st) (D.empty()) (f.sformals @ f.slocals) + (*remember all values of local vars*) + let st = List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in + if M.tracing then M.trace "startState" "return: added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; + D.add (var) value st) (D.empty()) (f.sformals @ f.slocals) in + (* remember value of tainted vars in the return variable *) + let tainted = ctx.ask (MayBeTainted) in + let st = D.add return_varinfo tainted st + in if M.tracing then M.tracel "wrpointer-tainted" "startState: %a; state: %a\n" AD.pretty tainted D.pretty st;st let query ctx (type a) (q: a Queries.t): a Queries.result = @@ -55,19 +60,20 @@ struct | _ -> Result.top q let enter ctx var_opt f args = - (* assign function parameters *) [ctx.local, ctx.local] let body ctx (f:fundec) = + (* assign function parameters *) List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var (duplicated_variable var), NoOffset) Value.pretty value; D.add (duplicated_variable var) value st) (D.empty()) f.sformals + let combine_env ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc au (f_ask: Queries.ask) = + ctx.local + let combine_assign ctx var_opt expr f exprs t_context_opt t ask = - (*remove duplicated vars and local vars *) - List.fold_left (fun st var -> - if M.tracing then M.trace "startState" "removing var: var: %a" d_lval (Var var, NoOffset); - D.remove (var) st) (D.empty()) (f.sformals @ f.slocals @ (List.map duplicated_variable f.sformals)) + (* remove duplicated vars and local vars *) + ctx.local end From 0882a0aae972c8c54b810ae91ebbfe8cbe37f03e Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 13 May 2024 12:14:00 +0200 Subject: [PATCH 108/323] remove tainted variables in wrpointer analysis in combine_env --- src/analyses/weaklyRelationalPointerAnalysis.ml | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 3c5577c1c1..5a96a1bbac 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -107,8 +107,8 @@ struct branch ctx exp true | _, _ -> ctx.local - let duplicated_variable var = { var with vid = - var.vid; vname = var.vname ^ "'" } - let original_variable var = { var with vid = - var.vid; vname = String.rchop var.vname } + let duplicated_variable var = { var with vid = - var.vid - 4; vname = var.vname ^ "'" } + let original_variable var = { var with vid = - (var.vid + 4); vname = String.rchop var.vname } (*First all local variables of the function are duplicated (by negating their ID), then we remember the value of each local variable at the beginning of the function @@ -132,9 +132,15 @@ struct (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) - let combine_env ctx var_opt expr f exprs t_context_opt t ask = + let combine_env ctx var_opt expr f exprs t_context_opt t (ask: Queries.ask) = let og_t = t in - let t = D.meet ctx.local t in + (*remove all variables that were tainted by the function*) + let tainted = (* find out the tainted variables from startState *) + ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) + in + if M.tracing then M.trace "wrpointer-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; + let local = D.remove_tainted_terms ask tainted ctx.local in + let t = D.meet local t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t @@ -157,4 +163,4 @@ struct end let _ = - MCP.register_analysis ~dep:["startState"] (module Spec : MCPSpec) + MCP.register_analysis ~dep:["startState"; "taintPartialContexts"] (module Spec : MCPSpec) From 4d5a96635cc1a0d46d86bdd25eb5c04e3fcca254 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 13 May 2024 12:16:12 +0200 Subject: [PATCH 109/323] add function to remove tainted variables to the wrpointer domain --- src/cdomains/weaklyRelationalPointerDomain.ml | 38 ++++++++++++++----- 1 file changed, 28 insertions(+), 10 deletions(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 9c43aee459..b314ea52b1 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -13,16 +13,23 @@ module MayBeEqual = struct module AD = ValueDomain.AD (*TODO: id should not clash with the other dummy values we have for function parameters*) - let dummy_varinfo typ = {dummyFunDec.svar with vtype=typ} + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ} let dummy_var var = T.term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=dummyFunDec.svar.vid-1;vname="@return"} + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="@return"} let return_var var = T.term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) - (**Find out if two addresses are possibly equal by using the MayPointTo query. - The parameter s is the size (in bits) of the value that t1 points to. *) + (**Find out if two addresses are possibly equal by using the MayPointTo query. *) + let may_point_to_address (ask:Queries.ask) adresses t2 off = + let exp2 = T.to_cil_sum ask off t2 in + let mpt1 = adresses in + let mpt2 = ask.f (MayPointTo exp2) in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res + let may_point_to_same_address (ask:Queries.ask) t1 t2 off = if T.equal t1 t2 then true else (* two local arrays can never point to the same array *) @@ -31,12 +38,8 @@ module MayBeEqual = struct | _ -> false in if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t2)) (T.get_var t2) then false else let exp1 = T.to_cil t1 in - let exp2 = T.to_cil_sum ask off t2 in let mpt1 = ask.f (MayPointTo exp1) in - let mpt2 = ask.f (MayPointTo exp2) in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nt1: %s; exp1: %a; res: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" - (T.show t1) d_plainexp exp1 AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res + may_point_to_address ask mpt1 t2 off (**Returns true iff by assigning to t1, the value of t2 could change. The parameter s is the size in bits of the variable t1 we are assigning to. *) @@ -65,6 +68,14 @@ module MayBeEqual = struct let res = (may_be_equal ask uf s t1 t2) in if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res + + let rec may_point_to_one_of_these_adresses ask adresses t2 = + match t2 with + | CC.Deref (v, z',_) -> + (may_point_to_address ask adresses v z') + || (may_point_to_one_of_these_adresses ask adresses v) + | CC.Addr _ -> false + end module D = struct @@ -111,7 +122,7 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> let cc = fst(join_eq a b) - in join_neq a.diseq b.diseq cc + in join_neq a.diseq b.diseq cc in if M.tracing then M.trace "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" (show_all a) (show_all b) (show_all res); @@ -171,4 +182,11 @@ module D = struct let cc = Option.map (fun cc -> (snd(insert cc term))) cc in Option.map (remove_terms (fun uf -> MayBeEqual.may_be_equal ask uf s term)) cc + + (** Remove terms from the data structure. + It removes all terms that may point to the same address as "tainted".*) + let remove_tainted_terms ask address cc = + if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; + Option.map (remove_terms (fun uf -> MayBeEqual.may_point_to_one_of_these_adresses ask address)) cc + end From 4532e5b09bbf3751bdaefb59c934d51b35b0663b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 13 May 2024 12:18:38 +0200 Subject: [PATCH 110/323] add taintPartialContext analysis to tests --- tests/regression/79-wrpointer/01-simple.c | 2 +- tests/regression/79-wrpointer/02-rel-simple.c | 2 +- tests/regression/79-wrpointer/03-function-call.c | 2 +- tests/regression/79-wrpointer/04-remove-vars.c | 2 +- tests/regression/79-wrpointer/05-branch.c | 2 +- tests/regression/79-wrpointer/06-invertible-assignment.c | 2 +- tests/regression/79-wrpointer/08-simple-assignment.c | 2 +- tests/regression/79-wrpointer/09-different-offsets.c | 2 +- tests/regression/79-wrpointer/10-different-types.c | 2 +- tests/regression/79-wrpointer/11-array.c | 2 +- tests/regression/79-wrpointer/12-rel-function.c | 2 +- tests/regression/79-wrpointer/13-experiments.c | 2 +- tests/regression/79-wrpointer/14-join.c | 2 +- tests/regression/79-wrpointer/15-arrays-structs.c | 2 +- tests/regression/79-wrpointer/16-loops.c | 2 +- tests/regression/79-wrpointer/17-join2.c | 2 +- tests/regression/79-wrpointer/18-complicated-join.c | 2 +- tests/regression/79-wrpointer/19-disequalities.c | 2 +- tests/regression/79-wrpointer/22-join-diseq.c | 2 +- 19 files changed, 19 insertions(+), 19 deletions(-) diff --git a/tests/regression/79-wrpointer/01-simple.c b/tests/regression/79-wrpointer/01-simple.c index 094067f9e4..abfbe7d655 100644 --- a/tests/regression/79-wrpointer/01-simple.c +++ b/tests/regression/79-wrpointer/01-simple.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/02-rel-simple.c b/tests/regression/79-wrpointer/02-rel-simple.c index 26abcdad70..bc3adff210 100644 --- a/tests/regression/79-wrpointer/02-rel-simple.c +++ b/tests/regression/79-wrpointer/02-rel-simple.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include #include diff --git a/tests/regression/79-wrpointer/03-function-call.c b/tests/regression/79-wrpointer/03-function-call.c index aad1060edd..759ab4bc0c 100644 --- a/tests/regression/79-wrpointer/03-function-call.c +++ b/tests/regression/79-wrpointer/03-function-call.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/04-remove-vars.c b/tests/regression/79-wrpointer/04-remove-vars.c index 34fde4d0bb..be228c0cb3 100644 --- a/tests/regression/79-wrpointer/04-remove-vars.c +++ b/tests/regression/79-wrpointer/04-remove-vars.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/79-wrpointer/05-branch.c index 7d26e8759a..37b08c3730 100644 --- a/tests/regression/79-wrpointer/05-branch.c +++ b/tests/regression/79-wrpointer/05-branch.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include void main(void) { diff --git a/tests/regression/79-wrpointer/06-invertible-assignment.c b/tests/regression/79-wrpointer/06-invertible-assignment.c index c961b1400f..bbc03fa0dd 100644 --- a/tests/regression/79-wrpointer/06-invertible-assignment.c +++ b/tests/regression/79-wrpointer/06-invertible-assignment.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include void main(void) { diff --git a/tests/regression/79-wrpointer/08-simple-assignment.c b/tests/regression/79-wrpointer/08-simple-assignment.c index 5ba3acb087..69de57a618 100644 --- a/tests/regression/79-wrpointer/08-simple-assignment.c +++ b/tests/regression/79-wrpointer/08-simple-assignment.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts // example of the paper "2-Pointer Logic" by Seidl et al., pag. 21 #include diff --git a/tests/regression/79-wrpointer/09-different-offsets.c b/tests/regression/79-wrpointer/09-different-offsets.c index 3e9e226268..b5e22bb247 100644 --- a/tests/regression/79-wrpointer/09-different-offsets.c +++ b/tests/regression/79-wrpointer/09-different-offsets.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/10-different-types.c b/tests/regression/79-wrpointer/10-different-types.c index 4f263d199b..868b1a4d8e 100644 --- a/tests/regression/79-wrpointer/10-different-types.c +++ b/tests/regression/79-wrpointer/10-different-types.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/11-array.c b/tests/regression/79-wrpointer/11-array.c index 549b2ab92a..a5d2e7e906 100644 --- a/tests/regression/79-wrpointer/11-array.c +++ b/tests/regression/79-wrpointer/11-array.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/12-rel-function.c b/tests/regression/79-wrpointer/12-rel-function.c index 03dd223eda..f4e97e858a 100644 --- a/tests/regression/79-wrpointer/12-rel-function.c +++ b/tests/regression/79-wrpointer/12-rel-function.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/13-experiments.c b/tests/regression/79-wrpointer/13-experiments.c index ccf22cfb44..5f7c0d9241 100644 --- a/tests/regression/79-wrpointer/13-experiments.c +++ b/tests/regression/79-wrpointer/13-experiments.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/14-join.c b/tests/regression/79-wrpointer/14-join.c index 45afe38386..5c1e3e069a 100644 --- a/tests/regression/79-wrpointer/14-join.c +++ b/tests/regression/79-wrpointer/14-join.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include diff --git a/tests/regression/79-wrpointer/15-arrays-structs.c b/tests/regression/79-wrpointer/15-arrays-structs.c index cbce0fae63..5a90e7a846 100644 --- a/tests/regression/79-wrpointer/15-arrays-structs.c +++ b/tests/regression/79-wrpointer/15-arrays-structs.c @@ -1,5 +1,5 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/16-loops.c b/tests/regression/79-wrpointer/16-loops.c index c8315c5b22..53419db7d4 100644 --- a/tests/regression/79-wrpointer/16-loops.c +++ b/tests/regression/79-wrpointer/16-loops.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/17-join2.c b/tests/regression/79-wrpointer/17-join2.c index bb1bfbea8f..a9300ad423 100644 --- a/tests/regression/79-wrpointer/17-join2.c +++ b/tests/regression/79-wrpointer/17-join2.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include diff --git a/tests/regression/79-wrpointer/18-complicated-join.c b/tests/regression/79-wrpointer/18-complicated-join.c index 8006387247..f5c04c6f5a 100644 --- a/tests/regression/79-wrpointer/18-complicated-join.c +++ b/tests/regression/79-wrpointer/18-complicated-join.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts // Example 1 from the paper Join Algorithms for the Theory of Uninterpreted // Functions by Gulwani et al. diff --git a/tests/regression/79-wrpointer/19-disequalities.c b/tests/regression/79-wrpointer/19-disequalities.c index 3d240a087c..bee70deea1 100644 --- a/tests/regression/79-wrpointer/19-disequalities.c +++ b/tests/regression/79-wrpointer/19-disequalities.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include diff --git a/tests/regression/79-wrpointer/22-join-diseq.c b/tests/regression/79-wrpointer/22-join-diseq.c index ffcfe15f3f..52bb1b3499 100644 --- a/tests/regression/79-wrpointer/22-join-diseq.c +++ b/tests/regression/79-wrpointer/22-join-diseq.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include From c167abea91c8552ce62b724e92bbe8c04609f446 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 13 May 2024 12:19:24 +0200 Subject: [PATCH 111/323] add test for tainted variables n a function --- .../79-wrpointer/23-function-deref.c | 25 +++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 tests/regression/79-wrpointer/23-function-deref.c diff --git a/tests/regression/79-wrpointer/23-function-deref.c b/tests/regression/79-wrpointer/23-function-deref.c new file mode 100644 index 0000000000..1052cec9c5 --- /dev/null +++ b/tests/regression/79-wrpointer/23-function-deref.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +void *g(int **a, int *b) { + b = (int *)malloc(sizeof(int *)); + *a = b; +} + +int main(void) { + int *i = (int *)malloc(sizeof(int)); + int **j; + j = (int **)malloc(sizeof(int *)); + *j = (int *)malloc(sizeof(int)); + int *k = *j; + + __goblint_check(k == *j); + + g(j, i); + + __goblint_check(k == *j); // UNKNOWN! + + return 0; +} From 9bd512d1635144d08bfdc4db03df5cbf01502c6d Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 14 May 2024 15:05:55 +0200 Subject: [PATCH 112/323] adapted the comments --- src/cdomains/congruenceClosure.ml | 200 ++++++++++++++---------------- 1 file changed, 92 insertions(+), 108 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index a2e4a9728a..7d0e14cbe5 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -10,19 +10,25 @@ exception Unsat type ('v, 't) term = Addr of 'v | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t [@@deriving eq, ord, hash] -(*terms*) +(** The terms consist of address constants and dereferencing function with sum of an integer. + The dereferencing function is parametrized by the size of the element in the memory. + We store the CIL expression of the term in the data type, such that it it easier to find the types of the dereferenced elements. + Also so that we can easily convert back from term to Cil expression. +*) module T = struct type exp = Cil.exp - (*equality of terms should not depend on the expression*) + (* equality of terms should not depend on the expression *) let compare_exp _ _ = 0 let equal_exp _ _ = true let hash_exp _ = 1 - (* term * size in bits of the element pointed to by the term *) + (* we store the varinfo and the Cil expression corresponding to thi term in the data type *) type t = (Var.t, exp) term [@@deriving eq, ord, hash] type v_prop = (Var.t, exp) prop [@@deriving ord, hash] + (** Two propositions are equal if they are syntactically equal + or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) let equal_v_prop p1 p2 = let equivalent_triple (t1,t2,o1) (t3,t4,o2) = (equal t1 t3 && equal t2 t4 && Z.equal o1 o2) || @@ -60,26 +66,18 @@ module T = struct | Deref (t, _, _) -> is_subterm st t | _ -> false - (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) - let rec contains_variable variables term = match term with - | Deref (t, _, _) -> contains_variable variables t - | Addr v -> List.mem v variables - let rec get_var = function | Addr v -> v | Deref (t, _, _) -> get_var t + (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) + let rec contains_variable variables term = List.mem (get_var term) variables + let term_of_varinfo vinfo = Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) exception UnsupportedCilExpression of string - (** Returns an integer from a cil expression and None if the expression is not an integer. *) - let z_of_exp = function - | Const (CInt (i, _, _)) -> i - | _-> (*because we performed constant folding*) - raise (UnsupportedCilExpression "non-constant value") - let eval_int (ask:Queries.ask) exp = match Cilfacade.get_ikind_exp exp with | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") @@ -100,11 +98,12 @@ module T = struct | exception (UnsupportedCilExpression _) -> None let rec get_size_in_bits typ = match typ with - | TArray (typ, _, _) -> get_size_in_bits (TPtr (typ,[])) + | TArray (typ, _, _) -> (* we treat arrays like pointers *) + get_size_in_bits (TPtr (typ,[])) | _ -> Z.of_int (bitsSizeOf typ) - (**Returns the size of the type. If typ is a pointer, it returns the - size of the elements it points to. If typ is an array, it returns the ize of the + (** Returns the size of the type. If typ is a pointer, it returns the + size of the elements it points to. If typ is an array, it returns the size of the elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int\[]\[]\[] = sizeof(int)). *) let rec get_element_size_in_bits typ = match typ with @@ -153,7 +152,7 @@ module T = struct | _ -> false (** For a type TPtr(t) it returns the type t. *) - let dereference_type = function (*TODO*) + let dereference_type = function | TPtr (typ, _) -> typ | typ -> let rec remove_array_and_struct_types = function | TArray (typ, _, _) -> remove_array_and_struct_types typ @@ -171,15 +170,8 @@ module T = struct | (Addr v) -> AddrOf (Var v, NoOffset) | (Deref (_, _, exp)) -> exp - let show t = let res = show t in - if M.tracing then M.trace "wrpointer-show" "t: %s; exp: %a" res d_exp (to_cil t); res - - let to_cil t = let exp = to_cil t in - if M.tracing then M.trace "wrpointer-cil-conversion2" "Term: %s; Exp: %a\n" - (show t) d_plainexp exp; - exp - let default_int_type = ILong + (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) let to_cil_constant z t = let z = Z.(z/ get_element_size_in_bits t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) let to_cil_sum ask off t = @@ -211,7 +203,6 @@ module T = struct | _ -> raise (UnsupportedCilExpression "not supported yet") end | TComp (cinfo, _) -> - if M.tracing then M.trace "wrpointer2" "%a\n" d_exp exp; let finfo = List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields in let index = Field (finfo, NoOffset) in begin match exp with @@ -232,14 +223,15 @@ module T = struct or None, Some offset is the expression equals an integer, or None, None if the expression can't be described by our analysis.*) let rec of_cil (ask:Queries.ask) e = match e with - | Const _ -> None, Z.(z_of_exp e) + | Const (CInt (i, _, _)) -> None, i + | Const _ -> raise (UnsupportedCilExpression "non-integer constant") | AlignOf _ | AlignOfE _ -> raise (UnsupportedCilExpression "unsupported AlignOf") | Lval lval -> Some (of_lval ask lval), Z.zero | StartOf lval -> Some (of_lval ask lval), Z.zero | AddrOf (Var var, NoOffset) -> Some (Addr var), Z.zero | AddrOf (Mem exp, NoOffset) -> of_cil ask exp - | UnOp (op,exp,typ)-> begin match op with + | UnOp (op,exp,typ) -> begin match op with | Neg -> let off = eval_int ask exp in None, Z.(-off) | _ -> raise (UnsupportedCilExpression "unsupported UnOp") end @@ -654,12 +646,17 @@ module CongruenceClosure = struct module Disequalities = struct - (* map: term -> z -> size of typ -> *(z + (typ * )t)*) + (* disequality map: + if t_1 -> z -> size of typ -> {t_2, t_3} + then we know that (typ)t_1 + z != (typ)t_2 + and also that (typ)t_1 + z != (typ)t_3 + *) type t = TSet.t ZMap.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) let empty = TMap.empty let remove = TMap.remove + (** Returns a list of tuples, which each represent a disequality *) let bindings = List.flatten % List.flatten % @@ -673,8 +670,9 @@ module CongruenceClosure = struct ) (ZMap.bindings zmap) ) % TMap.bindings - (** adds a mapping v -> r -> size -> {v'} to the map, or if there are already elements - in v -> r -> {..} then v* is added to the previous set *) + (** adds a mapping v -> r -> size -> { v' } to the map, + or if there are already elements + in v -> r -> {..} then v' is added to the previous set *) let map_set_add = LMap.map_add let shift = LMap.shift @@ -693,9 +691,9 @@ module CongruenceClosure = struct (** Map of partition, transform union find to a map of type V -> Z -> V set with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) - let comp_map part = List.fold_left (fun comp (v,_) -> - map_set_add (TUF.find_no_pc part v) v comp) - TMap.empty (TMap.bindings part) + let comp_map uf = List.fold_left (fun comp (v,_) -> + map_set_add (TUF.find_no_pc uf v) v comp) + TMap.empty (TMap.bindings uf) let flatten_map = ZMap.map (fun zmap -> List.fold_left @@ -711,28 +709,27 @@ module CongruenceClosure = struct in the representative class of t. It basically maps each state in the automata to its predecessors. *) - let get_args part = - let cmap = comp_map part in + let get_args uf = + let cmap = comp_map uf in let clist = TMap.bindings cmap in let arg = List.fold_left (fun arg (v, imap) -> let ilist = ZMap.bindings imap in - let imap_sizes = flatten_args (List.fold_left - (fun imap_sizes (size, map) - -> - let iarg = List.fold_left (fun iarg (r,set) -> - let list = List.filter_map (function - | Deref (v',r',_) -> - let (v0,r0) = TUF.find_no_pc part v' in - Some (v0,Z.(r0+r')) - | _ -> None) (TSet.elements set) in - ZMap.add r list iarg - ) - ZMap.empty (ZMap.bindings map) in - ZMap.add size iarg imap_sizes) - ZMap.empty ilist) in + let imap_sizes = flatten_args + (List.fold_left + (fun imap_sizes (size, map) -> + let iarg = List.fold_left (fun iarg (r,set) -> + let list = List.filter_map (function + | Deref (v',r',_) -> + let (v0,r0) = TUF.find_no_pc uf v' in + Some (v0,Z.(r0+r')) + | _ -> None) (TSet.elements set) in + ZMap.add r list iarg + ) ZMap.empty (ZMap.bindings map) in + ZMap.add size iarg imap_sizes) + ZMap.empty ilist) in TMap.add v imap_sizes arg) TMap.empty clist in - (part,cmap,arg) + (uf,cmap,arg) let fold_left2 f acc l1 l2 = List.fold_left ( @@ -770,15 +767,21 @@ module CongruenceClosure = struct else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 ) rest ilist ilist - (** used by NEQ *) - let init_neq (part,cmap,arg) = (* list of non-trivially implied dis-equalities *) - List.fold_left (check_neq (part,arg)) [] (TMap.bindings cmap) + (** Initialize the list of disequalities taking only implicit dis-equalities into account. + + Returns: List of non-trivially implied dis-equalities *) + let init_neq (uf,cmap,arg) = + List.fold_left (check_neq (uf,arg)) [] (TMap.bindings cmap) - (** used by NEQ *) - let init_list_neq (part,_,_) neg = (* list of normalized provided dis-equalities *) + (** Initialize the list of disequalities taking explicit dis-equalities into account. + + Parameters: union-find partition, explicit disequalities.battrs + + Returns: list of normalized provided dis-equalities *) + let init_list_neq uf neg = List.filter_map (fun (v1,v2,r) -> - let (v1,r1) = TUF.find_no_pc part v1 in - let (v2,r2) = TUF.find_no_pc part v2 in + let (v1,r1) = TUF.find_no_pc uf v1 in + let (v2,r2) = TUF.find_no_pc uf v2 in if T.compare v1 v2 = 0 then if r1 = Z.(r2+r) then raise Unsat else None else Some (v1,v2,Z.(r2-r1+r))) neg @@ -787,19 +790,19 @@ module CongruenceClosure = struct Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. *) - let rec propagate_neq (part,cmap,arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) - | [] -> neq (* part need not be returned: has been flattened during constr. of cmap *) - | (v1,v2,r) :: rest -> (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) + let rec propagate_neq (uf,cmap,arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) + | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) + | (v1,v2,r) :: rest -> (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) if T.equal v1 v2 then (* should not happen *) - if Z.equal r Z.zero then raise Unsat else propagate_neq (part,cmap,arg,neq) rest + if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) rest else (* check whether it is already in neq *) - if map_set_mem (v1,r) v2 neq then propagate_neq (part,cmap,arg,neq) rest + if map_set_mem (v1,r) v2 neq then propagate_neq (uf,cmap,arg,neq) rest else let neq = map_set_add (v1,Z.(-r)) v2 neq |> map_set_add (v2,r) v1 in - (* - search components of v1, v2 for elements at distance r to obtain inferred equalities - at the same level (not recorded) and then compare their predecessors - *) + (* + search components of v1, v2 for elements at distance r to obtain inferred equalities + at the same level (not recorded) and then compare their predecessors + *) match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with | None,_ | _,None -> raise (Failure "empty component?") | Some imap1, Some imap2 -> @@ -821,34 +824,23 @@ module CongruenceClosure = struct else if Z.equal (T.get_size v1) (T.get_size v2) then (v1,v2,Z.(r'2-r'1))::rest else rest ) rest l1 l2) rest ilist1 in - propagate_neq (part,cmap,arg,neq) rest - - (* - collection of disequalities: - * disequalities originating from different offsets of same root - * stated disequalities - * closure by collecting appropriate args - for a disequality v1 != v2 +r for distinct roots v1,v2 - check whether there is some r1, r2 such that r1 = r2 +r - then dis-equate the sets at v1,r1 with v2,r2. - *) + propagate_neq (uf,cmap,arg,neq) rest + (* + collection of disequalities: + * disequalities originating from different offsets of same root + * stated disequalities + * closure by collecting appropriate args + for a disequality v1 != v2 +r for distinct roots v1,v2 + check whether there is some r1, r2 such that r1 = r2 +r + then dis-equate the sets at v1,r1 with v2,r2. + *) let show_neq neq = - let clist = TMap.bindings neq in - List.fold_left (fun s (v,imap) -> - s ^ let ilist = ZMap.bindings imap in - List.fold_left (fun s (r,map) -> - s ^ let slist = ZMap.bindings map in - List.fold_left - (fun s (size,set) -> - s ^ let list = TSet.elements set in - List.fold_left - (fun s v' -> - s ^ "\t" ^ T.show v' ^ " != "^ - (if r = Z.zero then "" else - (Z.to_string r) ^" + ") - ^ T.show v ^ "\n") "" list)"" slist) - "" ilist) "" clist + let clist = bindings neq in + List.fold_left (fun s (v,r,size,v') -> + s ^ "\t" ^ T.show v' ^ " != " ^ (if r = Z.zero then "" else (Z.to_string r) ^" + ") + ^ T.show v ^ "\n") "" clist + let filter_map f (diseq:t) = TMap.filter_map (fun _ zmap -> @@ -1269,7 +1261,7 @@ module CongruenceClosure = struct let neq_list = Disequalities.init_neq (uf,cmap,arg) in let neq = Disequalities.propagate_neq (uf,cmap,arg,cc.diseq) neq_list in (* taking explicit dis-equalities into account *) - let neq_list = Disequalities.init_list_neq (uf,cmap,arg) neg in + let neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq} with Unsat -> None @@ -1475,18 +1467,11 @@ module CongruenceClosure = struct in List.fold_left remove_from_map (map, uf) removed_terms let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms predicate new_parents_map uf = - (* modify mapped values *) + (* modify mapped values + -> change terms to their new representatives or remove them, if the representative class was completely removed. *) let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (LMap.filter_if diseq (not % predicate)) in (* modify left hand side of map *) - let remove_from_diseq diseq term = - match LMap.find_opt term diseq with - | None -> diseq - | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) - match find_new_root new_parents_map uf term with - | None -> Disequalities.remove term diseq - | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term diseq - in List.fold_left remove_from_diseq diseq removed_terms - + remove_terms_from_map (uf, diseq) removed_terms new_parents_map (** Remove terms from the data structure. It removes all terms for which "predicate" is false, @@ -1502,7 +1487,7 @@ module CongruenceClosure = struct remove_terms_from_mapped_values cc.map (predicate cc.uf) in let map, uf = remove_terms_from_map (uf, map) removed_terms new_parents_map - in let diseq = + in let diseq, uf = remove_terms_from_diseq cc.diseq removed_terms (predicate cc.uf) new_parents_map uf in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) @@ -1510,6 +1495,7 @@ module CongruenceClosure = struct {uf; set; map; min_repr; diseq = cc.diseq} (* join *) + let join_eq cc1 cc2 = let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in let pmap = List.fold_left @@ -1554,6 +1540,4 @@ module CongruenceClosure = struct end end - - end From 2807b0104264838173da5cf1d97927fadecce28d Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 17 May 2024 13:28:03 +0200 Subject: [PATCH 113/323] fixed bug in join and added corresponding test --- src/cdomains/congruenceClosure.ml | 35 ++++++++------- tests/regression/79-wrpointer/26-join-test.c | 45 ++++++++++++++++++++ 2 files changed, 64 insertions(+), 16 deletions(-) create mode 100644 tests/regression/79-wrpointer/26-join-test.c diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7d0e14cbe5..970ed65c2f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1498,30 +1498,33 @@ module CongruenceClosure = struct let join_eq cc1 cc2 = let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in - let pmap = List.fold_left - (fun pmap a -> Map.add (a,a) (a,snd (TUF.find_no_pc cc1.uf a), snd (TUF.find_no_pc cc2.uf a)) pmap) - Map.empty atoms in - let working_set = List.combine atoms atoms in + let mappings = List.map + (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in + let r2, off2 = TUF.find_no_pc cc2.uf a in + (r1,r2,Z.(off2 - off1)), (a,off1)) atoms in + let pmap = List.fold_left (fun pmap (x1,x2) -> Map.add x1 x2 pmap) Map.empty mappings in + let working_set = List.map fst mappings in let cc = init_cc [] in - let add_one_edge y t t1_off t2_off (pmap, cc, new_pairs) (offset, size, a) = + let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, size, a) = let a', a_off = TUF.find_no_pc cc1.uf a in - match LMap.map_find_opt (y, Z.(t2_off - t1_off + offset)) size cc2.map with + match LMap.map_find_opt (y, Z.(diff + offset)) size cc2.map with | None -> pmap,cc,new_pairs | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in - let new_term = SSet.deref_term t Z.(offset - t1_off) cc1.set in - let _ , cc = insert cc new_term - in match Map.find_opt (a',b') pmap with - | None -> Map.add (a',b') (new_term, a_off, b_off) pmap, cc, (a',b')::new_pairs - | Some (c, c1_off, c2_off) -> - if Z.(equal (-c1_off + a_off) (-c2_off + b_off)) then + match SSet.deref_term t Z.(offset - t1_off) cc1.set with + | exception (T.UnsupportedCilExpression _) -> pmap,cc,new_pairs + | new_term -> + let _ , cc = insert cc new_term in + let new_element = a',b',Z.(b_off - a_off) in + match Map.find_opt new_element pmap with + | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs + | Some (c, c1_off) -> pmap, closure cc [new_term, c, Z.(-c1_off + a_off)],new_pairs - else pmap,cc,new_pairs (* If c and new_term don't have the same distance in cc1 and cc2, we forget that they are related. *) in let rec add_edges_to_map pmap cc = function | [] -> cc, pmap - | (x,y)::rest -> - let t,t1_off,t2_off = Map.find (x,y) pmap in - let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off t2_off) (pmap, cc, []) (LMap.successors x cc1.map) in + | (x,y,diff)::rest -> + let t,t1_off = Map.find (x,y,diff) pmap in + let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off diff) (pmap, cc, []) (LMap.successors x cc1.map) in add_edges_to_map pmap cc (rest@new_pairs) in add_edges_to_map pmap cc working_set diff --git a/tests/regression/79-wrpointer/26-join-test.c b/tests/regression/79-wrpointer/26-join-test.c new file mode 100644 index 0000000000..7b4531d7f3 --- /dev/null +++ b/tests/regression/79-wrpointer/26-join-test.c @@ -0,0 +1,45 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include +#include + +void main(void) { + long *x; + long *y; + long *z = malloc(sizeof(long)); + int top; + + if (top) { + x = z + 7; + y = z + 3; + } else { + x = z + 1; + y = z + 1; + } + + __goblint_check(x == z + 7); // UNKNOWN! + __goblint_check(x == z + 3); // UNKNOWN! + __goblint_check(x == z + 1); // UNKNOWN! + __goblint_check(x == z + 1); // UNKNOWN! + + long *x1; + long *x2; + long *y1; + long *y2; + + if (top) { + x1 = z + 1; + y1 = z + 2; + x2 = z + 1; + y2 = z + 2; + } else { + x1 = z + 2; + y1 = z + 3; + x2 = z + 4; + y2 = z + 5; + } + + __goblint_check(x1 == y1 - 1); + __goblint_check(x2 == y2 - 1); +} From 23213b31e18e12857a3fa7ecbf9dfc0f2366b6a6 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 20 May 2024 11:47:40 +0200 Subject: [PATCH 114/323] made join more precise and made widen = top --- src/cdomains/congruenceClosure.ml | 71 ++++++++++++------- src/cdomains/weaklyRelationalPointerDomain.ml | 9 ++- .../{26-join-test.c => 26-join3.c} | 0 .../regression/79-wrpointer/27-join-diseq2.c | 39 ++++++++++ 4 files changed, 89 insertions(+), 30 deletions(-) rename tests/regression/79-wrpointer/{26-join-test.c => 26-join3.c} (100%) create mode 100644 tests/regression/79-wrpointer/27-join-diseq2.c diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 970ed65c2f..ab22e9062e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -857,12 +857,34 @@ module CongruenceClosure = struct Nequal (t1,t2,z) ) % bindings - let intersect cmap1 cmap2 = - List.fold_left (fun result_map (t1, z, size, t2) -> - if map_set_mem (t1,z) t2 cmap2 then - map_set_add (t1,z) t2 result_map - else result_map) TMap.empty - (bindings cmap1) + let element_closure diseqs uf = + let cmap = comp_map uf in + let comp_closure (r1,r2,z) = + let find_size_64 = (*TODO don't hardcode 64*) + List.flatten % List.filter_map + (fun (z, zmap) -> Option.map + (fun l -> List.cartesian_product [z] (TSet.to_list l)) + (ZMap.find_opt (Z.of_int 64) zmap)) in + let comp_closure_zmap bindings1 bindings2 = + List.map (fun ((z1, nt1),(z2, nt2)) -> + (nt1, nt2, Z.(-z2+z+z1))) + (List.cartesian_product (find_size_64 bindings1) (find_size_64 bindings2)) + in + let singleton term = [Z.zero, ZMap.add (Z.of_int 64) (TSet.singleton term) ZMap.empty] in + begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with + | None, None -> [(r1,r2,z)] + | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) + | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) + | Some zmap1, Some zmap2 -> + comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) + end + in + List.flatten @@ List.map comp_closure diseqs + + + + + end (** Set of subterms which are present in the current data structure. *) @@ -1240,15 +1262,17 @@ module CongruenceClosure = struct (** Add all terms in a specific set to the data structure. Returns updated (uf, set, map, min_repr). *) - let insert_set_opt cc t_set = - match cc with - | None -> None - | Some cc -> - let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in - (* update min_repr at the end for more efficiency *) - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} + let insert_set t_set cc = + let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in + (* update min_repr at the end for more efficiency *) + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in + {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} + (** Add all terms in a specific set to the data structure. + + Returns updated (uf, set, map, min_repr). *) + let insert_set_opt cc t_set = + Option.map (insert_set t_set) cc (** used by NEQ *) let congruence_neq cc neg = @@ -1518,7 +1542,7 @@ module CongruenceClosure = struct match Map.find_opt new_element pmap with | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs | Some (c, c1_off) -> - pmap, closure cc [new_term, c, Z.(-c1_off + a_off)],new_pairs + pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in let rec add_edges_to_map pmap cc = function | [] -> cc, pmap @@ -1530,17 +1554,14 @@ module CongruenceClosure = struct add_edges_to_map pmap cc working_set (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) - let join_neq diseq1 diseq2 cc = + let join_neq diseq1 diseq2 cc1 cc2 cc = let _,diseq1 = split (Disequalities.get_disequalities diseq1) in let _,diseq2 = split (Disequalities.get_disequalities diseq2) in - let cc = insert_set_opt (Some cc) (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2)) in - begin match cc with - | None -> None - | Some cc -> - begin match congruence_neq cc diseq1, congruence_neq cc diseq2 with - | None, cc | cc, None -> cc - | Some cc1, Some cc2 -> Some {cc1 with diseq=Disequalities.intersect cc1.diseq cc2.diseq} - end - end + (* keep all disequalities from diseq1 that are implied by cc2 and + those from diseq2 that are implied by cc1 *) + let diseq1 = List.filter (neq_query cc2) (Disequalities.element_closure diseq1 cc1.uf) in + let diseq2 = List.filter (neq_query cc1) (Disequalities.element_closure diseq2 cc2.uf) in + let cc = insert_set (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2)) cc in + congruence_neq cc (diseq1 @ diseq2) end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index b314ea52b1..303c1b4a06 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -12,7 +12,6 @@ module T = CC.T module MayBeEqual = struct module AD = ValueDomain.AD - (*TODO: id should not clash with the other dummy values we have for function parameters*) let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ} let dummy_var var = T.term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) @@ -122,13 +121,13 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> let cc = fst(join_eq a b) - in join_neq a.diseq b.diseq cc + in join_neq a.diseq b.diseq a b cc in - if M.tracing then M.trace "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" - (show_all a) (show_all b) (show_all res); + if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" + (show a) (show b) (show res); res - let widen = join + let widen a b = top () let meet a b = match a,b with | None, _ -> None diff --git a/tests/regression/79-wrpointer/26-join-test.c b/tests/regression/79-wrpointer/26-join3.c similarity index 100% rename from tests/regression/79-wrpointer/26-join-test.c rename to tests/regression/79-wrpointer/26-join3.c diff --git a/tests/regression/79-wrpointer/27-join-diseq2.c b/tests/regression/79-wrpointer/27-join-diseq2.c new file mode 100644 index 0000000000..2ece6062d6 --- /dev/null +++ b/tests/regression/79-wrpointer/27-join-diseq2.c @@ -0,0 +1,39 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +int main(void) { + long *a; + long *b; + long *c; + long *d = (long *)malloc(4 * sizeof(long)); + long *e = (long *)malloc(4 * sizeof(long)); + + long *unknown; + + int top; + + if (a != b && e != c && c != d) { + __goblint_check(a != b); + __goblint_check(e != c); + __goblint_check(c != d); + if (top) { + d = unknown; + d = c + 1; + __goblint_check(a != b); + __goblint_check(e != c); + __goblint_check(c != d); // implicit disequality + } else { + e = unknown; + __goblint_check(a != b); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); + } + // JOIN + __goblint_check(a != b); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); + } + return 0; +} From 61058ea5d54d0f6c6ed7ceab4c85390f8bc13781 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 11:53:40 +0200 Subject: [PATCH 115/323] handle unknown left hand sides of assignments --- src/analyses/weaklyRelationalPointerAnalysis.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 5a96a1bbac..cc5a9361a3 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -62,8 +62,8 @@ struct meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> D.remove_terms_containing_variable dummy_var (* invertibe assignment *) - | exception (T.UnsupportedCilExpression _) -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) - | _ -> t (* TODO what if lhs is None? Just ignore? -> Not a good idea *) + | exception (T.UnsupportedCilExpression _) -> D.top () (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. This should almost never happen. *) + | _ -> D.top () let assign_lval_2_ask t (ask1: Queries.ask) (ask2: Queries.ask) lval expr = let f (type a) (q: a Queries.t) = From 4a253dbc800d2669a2e7e23494999eed54c9b5d4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 11:57:34 +0200 Subject: [PATCH 116/323] better calculation of dereferenced expression. Give up when it is not possible to dereference it further. --- src/cdomains/congruenceClosure.ml | 94 +++++++++---------- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 2 files changed, 48 insertions(+), 48 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index ab22e9062e..9eb88fd74e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -102,15 +102,17 @@ module T = struct get_size_in_bits (TPtr (typ,[])) | _ -> Z.of_int (bitsSizeOf typ) + let rec type_of_element typ = + match typ with + | TArray (typ, _, _) -> type_of_element typ + | TPtr (typ, _) -> typ + | _ -> typ + (** Returns the size of the type. If typ is a pointer, it returns the size of the elements it points to. If typ is an array, it returns the size of the elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int\[]\[]\[] = sizeof(int)). *) let rec get_element_size_in_bits typ = - match typ with - | TArray (typ, _, _) -> get_element_size_in_bits typ - | TPtr (typ, _) -> get_size_in_bits typ - (*TODO TComp*) - | _ -> get_size_in_bits typ + get_size_in_bits (type_of_element typ) let is_array_type = function | TArray _ -> true @@ -151,15 +153,6 @@ module T = struct | TPtr _| TArray _| TComp _ -> true | _ -> false - (** For a type TPtr(t) it returns the type t. *) - let dereference_type = function - | TPtr (typ, _) -> typ - | typ -> let rec remove_array_and_struct_types = function - | TArray (typ, _, _) -> remove_array_and_struct_types typ - | TComp (cinfo, _) -> raise (UnsupportedCilExpression "not supported yet") (*TODO*) - | typ -> typ - in remove_array_and_struct_types typ - let rec type_of_term = function | (Addr v) -> TPtr (v.vtype, []) @@ -174,27 +167,33 @@ module T = struct (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) let to_cil_constant z t = let z = Z.(z/ get_element_size_in_bits t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) - let to_cil_sum ask off t = - let cil_t = to_cil t in + let to_cil_sum off cil_t = if Z.(equal zero off) then cil_t else - let vtype = type_of_term t in - match vtype with - | TArray (typ, length, _) -> cil_t - | _ -> - BinOp (PlusPI, cil_t, to_cil_constant off vtype, vtype) + let typ = typeOf cil_t in + let el_typ = type_of_element typ in + BinOp (PlusPI, cil_t, to_cil_constant off el_typ, typ) let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with | Some i -> i | None -> raise (UnsupportedCilExpression "unknown offset") + let rec add_index_to_exp exp index = + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | BinOp (PlusPI, exp1, Const (CInt (z, _ , _ )), _)when Z.equal z Z.zero -> + add_index_to_exp exp1 index + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + let dereference_exp exp offset = + let find_field cinfo = Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) in match exp with | AddrOf lval -> Lval lval | _ -> match typeOf exp with - | TPtr (typ, _) when Z.equal offset Z.zero -> Lval (Mem exp, NoOffset) - | TPtr (typ, _) -> - BinOp (PlusPI, Lval (Mem exp, NoOffset), to_cil_constant offset typ, typeOfLval (Mem exp, NoOffset)) + | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) + | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) | TArray (typ, _, _) when not (can_be_dereferenced typ) -> let index = Index (to_cil_constant offset typ, NoOffset) in begin match exp with @@ -202,15 +201,8 @@ module T = struct | Lval (Mem v, NoOffset) -> Lval (Mem v, index) | _ -> raise (UnsupportedCilExpression "not supported yet") end - | TComp (cinfo, _) -> - let finfo = List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields in - let index = Field (finfo, NoOffset) in - begin match exp with - | Lval (Var v, NoOffset) -> Lval (Var v, index) - | Lval (Mem v, NoOffset) -> Lval (Mem v, index) - | _ -> raise (UnsupportedCilExpression "not supported yet") - end - | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), exp)), NoOffset) + | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) + | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) let get_size = get_size_in_bits % type_of_term @@ -961,14 +953,17 @@ module CongruenceClosure = struct let process_edge (min_representatives, queue, uf) (edge_z, _(*min_repr is independent of the size*), next_term) = let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in - let next_min = (SSet.deref_term min_term Z.(edge_z - min_z) set, next_z) in - match TMap.find_opt next_state min_representatives - with - | None -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | _ -> (min_representatives, queue, uf) + match (SSet.deref_term min_term Z.(edge_z - min_z) set, next_z) with + | exception (T.UnsupportedCilExpression _) -> + min_representatives, queue, uf + | next_min -> + match TMap.find_opt next_state min_representatives + with + | None -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | _ -> (min_representatives, queue, uf) in let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges in update_min_repr (uf, set, map) min_representatives queue @@ -1077,7 +1072,9 @@ module CongruenceClosure = struct List.filter_map (fun (z,s,_ (*size is not important for normal form?*),(s',z')) -> let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in - normalize_equality (SSet.deref_term min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) + match normalize_equality (SSet.deref_term min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) with + | exception (T.UnsupportedCilExpression _) -> None + | eq -> eq ) transitions in (*disequalities*) let disequalities = Disequalities.get_disequalities cc.diseq @@ -1358,11 +1355,14 @@ module CongruenceClosure = struct let add_one_successor (cc, successors) (edge_z, _, _) = let _, uf_offset, uf = TUF.find cc.uf t in let cc = {cc with uf = uf} in - let successor = SSet.deref_term t Z.(edge_z - uf_offset) cc.set in - let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in - let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] - else insert_no_min_repr cc successor in - (cc, if subterm_already_present then successors else successor::successors) in + match SSet.deref_term t Z.(edge_z - uf_offset) cc.set with + | exception (T.UnsupportedCilExpression _) -> + (cc, successors) + | successor -> + let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in + let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] + else insert_no_min_repr cc successor in + (cc, if subterm_already_present then successors else successor::successors) in List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) (** Parameters: diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 303c1b4a06..3a90d701d9 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -22,7 +22,7 @@ module MayBeEqual = struct (**Find out if two addresses are possibly equal by using the MayPointTo query. *) let may_point_to_address (ask:Queries.ask) adresses t2 off = - let exp2 = T.to_cil_sum ask off t2 in + let exp2 = T.to_cil_sum off (T.to_cil t2) in let mpt1 = adresses in let mpt2 = ask.f (MayPointTo exp2) in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in From 69464f7cafca88c1a26f8f4b2855d3ab9f4b1692 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 12:21:46 +0200 Subject: [PATCH 117/323] check validity of dereferenced expressions --- src/cdomains/congruenceClosure.ml | 33 +++++++++++++++++-------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9eb88fd74e..3e3fb830e2 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -188,21 +188,24 @@ module T = struct let dereference_exp exp offset = let find_field cinfo = Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) in - match exp with - | AddrOf lval -> Lval lval - | _ -> - match typeOf exp with - | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) - | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) - | TArray (typ, _, _) when not (can_be_dereferenced typ) -> - let index = Index (to_cil_constant offset typ, NoOffset) in - begin match exp with - | Lval (Var v, NoOffset) -> Lval (Var v, index) - | Lval (Mem v, NoOffset) -> Lval (Mem v, index) - | _ -> raise (UnsupportedCilExpression "not supported yet") - end - | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) - | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) + let res = match exp with + | AddrOf lval -> Lval lval + | _ -> + match typeOf exp with + | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) + | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) + | TArray (typ, _, _) when not (can_be_dereferenced typ) -> + let index = Index (to_cil_constant offset typ, NoOffset) in + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) + | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) + in match typeOf res with (* we want to make sure that the expression is valid *) + | exception GoblintCil__Errormsg.Error -> raise (UnsupportedCilExpression "this expression is not coherent") + | _ -> res let get_size = get_size_in_bits % type_of_term From b60a9a19c6c37393785832f8fb626ab2a80be4cf Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 12:32:28 +0200 Subject: [PATCH 118/323] adapt enter and combine to follow the goblint assumptions --- .../weaklyRelationalPointerAnalysis.ml | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index cc5a9361a3..05b9249fa1 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -115,31 +115,35 @@ struct by using the analysis startState. This way we can infer the relations between the local variables of the caller and the pointers that were modified by the function. *) let enter ctx var_opt f args = - (* assign function parameters to duplicated values *) - let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in - if M.tracing then M.trace "wrpointer-function" "ENTER1: state_with_assignments: %s\n" (D.show state_with_assignments); (* add duplicated variables, and set them equal to the original variables *) let added_equalities = (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in - let state_with_duplicated_vars = meet_conjs_opt added_equalities state_with_assignments in + let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals (*@ all globals*) in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in if M.tracing then M.trace "wrpointer-function" "ENTER3: result: %s\n" (D.show new_state); - [state_with_assignments, new_state] + [ctx.local, new_state] (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) let combine_env ctx var_opt expr f exprs t_context_opt t (ask: Queries.ask) = + ctx.local + + (*ctx.local is after combine_env, t callee*) + let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = let og_t = t in + (* assign function parameters to duplicated values *) + let arg_assigns = GobList.combine_short f.sformals args in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in + if M.tracing then M.trace "wrpointer-function" "ENTER1: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = (* find out the tainted variables from startState *) ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) in if M.tracing then M.trace "wrpointer-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; - let local = D.remove_tainted_terms ask tainted ctx.local in + let local = D.remove_tainted_terms ask tainted state_with_assignments in let t = D.meet local t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with @@ -153,10 +157,6 @@ struct D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t - (*ctx.local is after combine_env, t callee*) - let combine_assign ctx var_opt expr f exprs t_context_opt t ask = - ctx.local - let threadenter ctx ~multiple var_opt v exprs = [ctx.local] let threadspawn ctx ~multiple var_opt v exprs ctx2 = ctx.local From 6c4b78e856bb04bd6c62023a5d62bae58a9bf0ea Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 14:31:14 +0200 Subject: [PATCH 119/323] modify comments --- src/analyses/weaklyRelationalPointerAnalysis.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 05b9249fa1..edde31c44a 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -65,6 +65,7 @@ struct | exception (T.UnsupportedCilExpression _) -> D.top () (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. This should almost never happen. *) | _ -> D.top () + (*TODO remove*) let assign_lval_2_ask t (ask1: Queries.ask) (ask2: Queries.ask) lval expr = let f (type a) (q: a Queries.t) = let module Result = (val Queries.Result.lattice q) in @@ -118,12 +119,12 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "wrpointer-function" "ENTER2: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals (*@ all globals*) in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in - if M.tracing then M.trace "wrpointer-function" "ENTER3: result: %s\n" (D.show new_state); + if M.tracing then M.trace "wrpointer-function" "ENTER2: result: %s\n" (D.show new_state); [ctx.local, new_state] (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t @@ -137,7 +138,7 @@ struct (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in - if M.tracing then M.trace "wrpointer-function" "ENTER1: state_with_assignments: %s\n" (D.show state_with_assignments); + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = (* find out the tainted variables from startState *) ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) From 9fae17fe47ba75fb12725e07e4b1e15bd2d6c738 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 15:27:05 +0200 Subject: [PATCH 120/323] keep all global and all reachable variables in enter --- src/analyses/weaklyRelationalPointerAnalysis.ml | 11 +++++++++-- src/cdomains/weaklyRelationalPointerDomain.ml | 3 ++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index edde31c44a..df8a2a54fb 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -20,6 +20,12 @@ struct let startstate v = D.empty() let exitstate v = D.empty() + (* find reachable variables in a function *) + let reachable_from_args ctx args = + let res = + List.fold (fun vs e -> vs @ (ctx.ask (ReachableFrom e) |> Queries.AD.to_var_may)) [] args in + if M.tracing then M.tracel "wrpointer-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res + (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, and None if we don't know anyhing. *) @@ -120,8 +126,9 @@ struct let added_equalities = (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); - (* remove callee vars *) - let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals (*@ all globals*) + (* remove callee vars that are not reachable and not global *) + let reachable_variables = + f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in if M.tracing then M.trace "wrpointer-function" "ENTER2: result: %s\n" (D.show new_state); diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 3a90d701d9..279707e611 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -169,10 +169,11 @@ module D = struct (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", + except the global vars are also keeped (when vstorage = static), while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.map (remove_terms (fun _ -> not % T.contains_variable vars)) cc + Option.map (remove_terms (fun _ t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) From 26a51a8909a159dfa374d9af1aa2663269078667 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 15:28:43 +0200 Subject: [PATCH 121/323] added tests for structs and recursive functions --- .../79-wrpointer/20-self-pointing-struct.c | 21 ++++++++++ tests/regression/79-wrpointer/21-global-var.c | 40 +++++++++++++++++++ 2 files changed, 61 insertions(+) create mode 100644 tests/regression/79-wrpointer/20-self-pointing-struct.c create mode 100644 tests/regression/79-wrpointer/21-global-var.c diff --git a/tests/regression/79-wrpointer/20-self-pointing-struct.c b/tests/regression/79-wrpointer/20-self-pointing-struct.c new file mode 100644 index 0000000000..4221cab013 --- /dev/null +++ b/tests/regression/79-wrpointer/20-self-pointing-struct.c @@ -0,0 +1,21 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +struct list { + int data; + struct list *next; +}; + +void main(void) { + struct list last = { + 41 + }; + struct list first = { + 42, &last + }; + + last.next = &last; + + __goblint_check(first.next->next->next->next == &last); +} diff --git a/tests/regression/79-wrpointer/21-global-var.c b/tests/regression/79-wrpointer/21-global-var.c new file mode 100644 index 0000000000..f8587f3484 --- /dev/null +++ b/tests/regression/79-wrpointer/21-global-var.c @@ -0,0 +1,40 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +int **i; +int **j; +int counter; + +void f() { __goblint_check(*i == *j); } + +void recursive_f() { + __goblint_check(*i == *j); + counter++; + if (counter < 25) + recursive_f(); +} + +void non_terminating_f() { + if (*i == *j) + non_terminating_f(); +} + +int main(void) { + + j = (int **)malloc(sizeof(int *)); + i = (int **)malloc(sizeof(int *)); + *i = (int *)malloc(sizeof(int)); + + *j = *i; + f(); + + recursive_f(); + + non_terminating_f(); + + __goblint_check(0); // NOWARN (unreachable) + + return 0; +} From 63216df1250997dbefe2387fa150c3db91b34331 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 15:39:13 +0200 Subject: [PATCH 122/323] remove a raise Failure --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 3e3fb830e2..c0041d3fc4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -799,7 +799,7 @@ module CongruenceClosure = struct at the same level (not recorded) and then compare their predecessors *) match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with - | None,_ | _,None -> raise (Failure "empty component?") + | None,_ | _,None -> (*should not happen*) propagate_neq (uf,cmap,arg,neq) rest | Some imap1, Some imap2 -> let ilist1 = ZMap.bindings imap1 in let rest = List.fold_left (fun rest (r1,_) -> From 4cba62698da0f0d1f502e1509fc43526b3fa9a61 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 21 May 2024 16:05:17 +0200 Subject: [PATCH 123/323] make sure that the min_repr is always defined in any case, even when it's not possible to calculate a dereference --- src/cdomains/congruenceClosure.ml | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c0041d3fc4..e7f5524a73 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -956,17 +956,19 @@ module CongruenceClosure = struct let process_edge (min_representatives, queue, uf) (edge_z, _(*min_repr is independent of the size*), next_term) = let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in - match (SSet.deref_term min_term Z.(edge_z - min_z) set, next_z) with - | exception (T.UnsupportedCilExpression _) -> - min_representatives, queue, uf - | next_min -> - match TMap.find_opt next_state min_representatives - with - | None -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | _ -> (min_representatives, queue, uf) + let next_min = + match (SSet.deref_term min_term Z.(edge_z - min_z) set, next_z) with + | exception (T.UnsupportedCilExpression _) -> + let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr*) + Deref (min_term, Z.(edge_z - min_z), Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant Z.(edge_z - min_z) random_type, random_type)), NoOffset)), next_z + | next_min -> next_min in + match TMap.find_opt next_state min_representatives + with + | None -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | _ -> (min_representatives, queue, uf) in let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges in update_min_repr (uf, set, map) min_representatives queue From 2d8cd98eff06e808552241d9c0cc0f17f0659b65 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 24 May 2024 11:04:20 +0200 Subject: [PATCH 124/323] add descriptions --- src/analyses/startStateAnalysis.ml | 9 +++++---- src/analyses/weaklyRelationalPointerAnalysis.ml | 13 ++----------- src/cdomains/congruenceClosure.ml | 9 ++------- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 4 files changed, 10 insertions(+), 23 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 5ab70e725b..e79512ab70 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -1,4 +1,4 @@ -(** Remembers the Value of each parameter at the beginning of each function. +(** Remembers the abstract address value of each parameter at the beginning of each function by adding a ghost variable for each parameter. Used by the wrpointer anaylysis. *) open GoblintCil @@ -28,8 +28,8 @@ struct let get_value (ask: Queries.ask) exp = ask.f (MayPointTo exp) (** If e is a known variable, then it returns the value for this variable. - If e is an unknown variable, then it returns bot. - If e is another expression that is not simply a variable, then it returns top. *) + If e is &x' for a duplicated variable x' of x, then it returns MayPointTo of &x. + If e is an unknown variable or an expression that is not simply a variable, then it returns top. *) let eval (ask: Queries.ask) (d: D.t) (exp: exp): Value.t = match exp with | Lval (Var x, NoOffset) -> begin match D.find_opt x d with | Some v -> if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v @@ -41,8 +41,9 @@ struct let startstate v = D.bot () let exitstate = startstate + (* TODO: there should be a better way to do this, this should be removed here. *) let return ctx exp_opt f = - (*remember all values of local vars*) + (* remember all values of local vars *) let st = List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in if M.tracing then M.trace "startState" "return: added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; D.add (var) value st) (D.empty()) (f.sformals @ f.slocals) in diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index df8a2a54fb..dbdab1bd58 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -1,6 +1,4 @@ -(** A Weakly-Relational Pointer Analysis..([wrpointer])*) - -(** TODO description *) +(** A Weakly-Relational Pointer Analysis. The analysis can infer equalities and disequalities between terms which are built from pointer variables, with the addition of constants and dereferencing. ([wrpointer])*) open Analyses open GoblintCil @@ -71,13 +69,6 @@ struct | exception (T.UnsupportedCilExpression _) -> D.top () (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. This should almost never happen. *) | _ -> D.top () - (*TODO remove*) - let assign_lval_2_ask t (ask1: Queries.ask) (ask2: Queries.ask) lval expr = - let f (type a) (q: a Queries.t) = - let module Result = (val Queries.Result.lattice q) in - Result.meet (ask1.f q) (ask2.f q) in - let (ask: Queries.ask) = {f} in assign_lval t ask lval expr - let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res @@ -156,7 +147,7 @@ struct if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t - | Some var -> assign_lval_2_ask t (ask_of_ctx ctx) ask var (MayBeEqual.return_lval (typeOfLval var)) + | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let local_vars = f.sformals @ f.slocals in diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index e7f5524a73..ad245640e9 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -855,11 +855,11 @@ module CongruenceClosure = struct let element_closure diseqs uf = let cmap = comp_map uf in let comp_closure (r1,r2,z) = - let find_size_64 = (*TODO don't hardcode 64*) + let find_size_64 = (*TODO this is not the best solution*) List.flatten % List.filter_map (fun (z, zmap) -> Option.map (fun l -> List.cartesian_product [z] (TSet.to_list l)) - (ZMap.find_opt (Z.of_int 64) zmap)) in + (ZMap.find_opt (T.get_size_in_bits (TPtr (TVoid [], []))) zmap)) in let comp_closure_zmap bindings1 bindings2 = List.map (fun ((z1, nt1),(z2, nt2)) -> (nt1, nt2, Z.(-z2+z+z1))) @@ -875,11 +875,6 @@ module CongruenceClosure = struct end in List.flatten @@ List.map comp_closure diseqs - - - - - end (** Set of subterms which are present in the current data structure. *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 279707e611..0d94e255e7 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -127,7 +127,7 @@ module D = struct (show a) (show b) (show res); res - let widen a b = top () + let widen a b = join a b let meet a b = match a,b with | None, _ -> None From a1b8a36f25db1c7f8007e75001750115422bfc01 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 24 May 2024 11:56:02 +0200 Subject: [PATCH 125/323] adapted some tests --- tests/regression/79-wrpointer/05-branch.c | 1 + .../79-wrpointer/07-invertible-assignment2.c | 28 ++++++++----------- tests/regression/79-wrpointer/11-array.c | 3 -- .../79-wrpointer/15-arrays-structs.c | 7 +---- tests/regression/79-wrpointer/16-loops.c | 22 ++++++++------- .../79-wrpointer/25-struct-circular.c | 28 +++++++++++++++++++ 6 files changed, 54 insertions(+), 35 deletions(-) create mode 100644 tests/regression/79-wrpointer/25-struct-circular.c diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/79-wrpointer/05-branch.c index 37b08c3730..c313cf117e 100644 --- a/tests/regression/79-wrpointer/05-branch.c +++ b/tests/regression/79-wrpointer/05-branch.c @@ -1,4 +1,5 @@ // PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include #include void main(void) { diff --git a/tests/regression/79-wrpointer/07-invertible-assignment2.c b/tests/regression/79-wrpointer/07-invertible-assignment2.c index 1763df71de..8d79140c3b 100644 --- a/tests/regression/79-wrpointer/07-invertible-assignment2.c +++ b/tests/regression/79-wrpointer/07-invertible-assignment2.c @@ -1,26 +1,22 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts // example of the paper "2-Pointer Logic" by Seidl et al., Example 9, pag. 22 #include #include void main(void) { - int *x = (int*)malloc(sizeof(int)); - int **z = (int**)malloc(sizeof(int*)); - *z = x; - int *y = (int*)malloc(sizeof(int*)); - int top; - if(top){ - y = (int*)z; - *x = (long)z; - } - *y = -1 + *x; + long x; + long *z; + z = &x; + long y; - __goblint_check(*z == x); - __goblint_check(*y == -1 + *x); + y = -1 + x; - **z = 1 + *x; + __goblint_check(z == &x); + __goblint_check(y == -1 + x); - __goblint_check(x == *z); - __goblint_check(*y == -2 + *x); + *z = 1 + x; + + __goblint_check(&x == z); + __goblint_check(y == -2 + x); } diff --git a/tests/regression/79-wrpointer/11-array.c b/tests/regression/79-wrpointer/11-array.c index a5d2e7e906..1b16488105 100644 --- a/tests/regression/79-wrpointer/11-array.c +++ b/tests/regression/79-wrpointer/11-array.c @@ -18,7 +18,4 @@ void main(void) { __goblint_check(l == *(j + 3)); __goblint_check(j[2] == m); - j = &k + 1; - - __goblint_check(j == &k); // FAIL } diff --git a/tests/regression/79-wrpointer/15-arrays-structs.c b/tests/regression/79-wrpointer/15-arrays-structs.c index 5a90e7a846..bcf0028e6f 100644 --- a/tests/regression/79-wrpointer/15-arrays-structs.c +++ b/tests/regression/79-wrpointer/15-arrays-structs.c @@ -1,4 +1,3 @@ - // PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts #include #include @@ -17,7 +16,6 @@ void main(void) { // array of struct struct mystruct arrayStructs[3]; - // printf("%d == %d \n", arrayStructs[2].first, ((int *)arrayStructs)[3]); __goblint_check(arrayStructs[0].first == ((int *)arrayStructs)[0]); // they are the same element __goblint_check(arrayStructs[1].second == @@ -56,10 +54,7 @@ void main(void) { __goblint_check((int *)array2D + 4 == (int *)array2D[2]); // 3D array - int array3D[2][3][4] ; - // = { - // {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}, - // {{13, 14, 15, 16}, {17, 18, 19, 20}, {21, 22, 23, 24}}}; + int array3D[2][3][4]; __goblint_check(array3D[1][0][3] == *((int *)array3D + 15)); __goblint_check(array3D[1][2][0] == *((int *)array3D + 20)); __goblint_check(array3D[1][2][3] == *((int *)array3D + 23)); diff --git a/tests/regression/79-wrpointer/16-loops.c b/tests/regression/79-wrpointer/16-loops.c index 53419db7d4..f7e0a0e178 100644 --- a/tests/regression/79-wrpointer/16-loops.c +++ b/tests/regression/79-wrpointer/16-loops.c @@ -1,26 +1,28 @@ // PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include #include +#include void main(void) { long y; long i; - long x; + long *x = malloc(sizeof(long) * 300); + long *x2 = x; long *z; int top; + top = top % 300; // top is some number that is < 300 - y = x; - z = -1 + &x; + y = *x; + z = -1 + x; while (top) { - int top2; - z = (long*)malloc(sizeof(long)); - z = -1 + &x; + z = (long *)malloc(sizeof(long)); + x++; + z = -1 + x; y++; - top = top2; + top--; } - __goblint_check(z == -1 + &x); - __goblint_check(y == x); // UNKNOWN! + __goblint_check(z == -1 + x); + __goblint_check(y == *x2); // UNKNOWN! } diff --git a/tests/regression/79-wrpointer/25-struct-circular.c b/tests/regression/79-wrpointer/25-struct-circular.c new file mode 100644 index 0000000000..ff1bed0a77 --- /dev/null +++ b/tests/regression/79-wrpointer/25-struct-circular.c @@ -0,0 +1,28 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include + +struct mem { + int val; +}; + +struct list_node { + int x; + struct mem *mem; + struct list_node *next; +}; + +int main() { + struct mem *m = malloc(sizeof(*m)); + int x = ((struct mem *) m)->val; + m->val = 100; + + struct list_node *head = malloc(sizeof(*head)); + + head->x = 1; + head->mem = m; + head->next = head; + + __goblint_check(head->next == head); + __goblint_check(head->next->next == head->next); +} From 9e4a4f9ca208a5512fcf2878d7a835dd0c0823cb Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 24 May 2024 11:58:43 +0200 Subject: [PATCH 126/323] fix bug when computing minimal representatives --- src/cdomains/congruenceClosure.ml | 12 +++++++++--- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index ad245640e9..c8e38b496a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -989,7 +989,8 @@ module CongruenceClosure = struct let update_min_repr (uf, set, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = - List.sort_unique (fun el1 el2 -> TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives)) (List.filter (TUF.is_root uf) queue) + List.sort_unique (fun el1 el2 -> let compare_repr = TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives) in + if compare_repr = 0 then T.compare el1 el2 else compare_repr) (List.filter (TUF.is_root uf) queue) in update_min_repr (uf, set, map) min_representatives queue (** @@ -1000,6 +1001,7 @@ module CongruenceClosure = struct - The map with the minimal representatives - The union find tree. This might have changed because of path compression. *) let compute_minimal_representatives (uf, set, map) = + if M.tracing then M.trace "wrpointer" "compute_minimal_representatives\n"; let atoms = SSet.get_atoms set in (* process all atoms in increasing order *) let uf_ref = ref uf in @@ -1009,7 +1011,9 @@ module CongruenceClosure = struct uf_ref := new_uf; let v2, z2, new_uf = TUF.find !uf_ref el2 in uf_ref := new_uf; - TUF.compare_repr (v1, z1) (v2, z2)) atoms in + let repr_compare = TUF.compare_repr (v1, z1) (v2, z2) + in + if repr_compare = 0 then T.compare el1 el2 else repr_compare) atoms in let add_atom_to_map (min_representatives, queue, uf) a = let (rep, offs, uf) = TUF.find uf a in if not (mem rep min_representatives) then @@ -1197,7 +1201,9 @@ module CongruenceClosure = struct *) let closure cc conjs = let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in - let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in + (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) + let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in + if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); {uf; set = cc.set; map; min_repr; diseq = cc.diseq} (** Splits the conjunction into two groups: the first one contains all equality propositions, diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 0d94e255e7..1550312cda 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -127,7 +127,7 @@ module D = struct (show a) (show b) (show res); res - let widen a b = join a b + let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b let meet a b = match a,b with | None, _ -> None From f034b0acd8817df76cdc1d239d4f261c97294430 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 24 May 2024 12:10:46 +0200 Subject: [PATCH 127/323] fix linter warnings --- src/cdomains/congruenceClosure.ml | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c8e38b496a..cbf37e0143 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -547,7 +547,7 @@ module LookupMap = struct let zmap_bindings zmap = let distribute_pair (a, xs) = List.map (fun (x,y) -> (a,x,y)) xs in - (List.flatten @@ List.map distribute_pair + (List.concat_map distribute_pair (List.map (Tuple2.map2 ZMap.bindings) (ZMap.bindings zmap))) let zmap_bindings_of_size s zmap = @@ -598,8 +598,6 @@ module LookupMap = struct "" (zmap_bindings zmap) ^ "\n") "" (bindings map) - let print_map = print_string % show_map - (** The value at v' is shifted by r and then added for v. The old entry for v' is removed. *) let shift v r v' map = @@ -655,8 +653,7 @@ module CongruenceClosure = struct let bindings = List.flatten % List.flatten % - List.flatten % - List.map (fun (t, zmap) -> + List.concat_map (fun (t, zmap) -> List.map (fun (z, smap) -> List.map (fun (size, tset) -> List.map (fun term -> @@ -874,7 +871,7 @@ module CongruenceClosure = struct comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) end in - List.flatten @@ List.map comp_closure diseqs + List.concat_map comp_closure diseqs end (** Set of subterms which are present in the current data structure. *) @@ -941,8 +938,6 @@ module CongruenceClosure = struct in List.fold_left show_one_rep "" (bindings min_representatives) - let print_min_rep = print_string % show_min_rep - let rec update_min_repr (uf, set, map) min_representatives = function | [] -> min_representatives, uf | state::queue -> (* process all outgoing edges in order of ascending edge labels *) @@ -1046,11 +1041,9 @@ module CongruenceClosure = struct let show_conj list = List.fold_left (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list - let print_conj = print_string % show_conj - (** Returns a list of all the transition that are present in the automata. *) let get_transitions (uf, map) = - List.flatten @@ List.map (fun (t, zmap) -> + List.concat_map (fun (t, zmap) -> (List.map (fun (edge_z, edge_size, res_t) -> (edge_z, t, edge_size, TUF.find_no_pc uf (LMap.set_any res_t))) @@ (LMap.zmap_bindings zmap))) From 975aa46c24df5ded951d424a8ce4aef4065111c1 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 24 May 2024 13:40:53 +0200 Subject: [PATCH 128/323] add startcontext --- src/analyses/startStateAnalysis.ml | 1 + src/analyses/weaklyRelationalPointerAnalysis.ml | 1 + src/cdomains/congruenceClosure.ml | 5 ++--- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index e79512ab70..d982885a2c 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -38,6 +38,7 @@ struct | AddrOf (Var x, NoOffset) -> if x.vid < -1 then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty res;res) else Value.top() | _ -> Value.top () + let startcontext () = D.top () let startstate v = D.bot () let exitstate = startstate diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index dbdab1bd58..1fd8952d55 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -15,6 +15,7 @@ struct module C = D let name () = "wrpointer" + let startcontext () = D.empty () let startstate v = D.empty() let exitstate v = D.empty() diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index cbf37e0143..ae90a9b42c 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -728,9 +728,8 @@ module CongruenceClosure = struct fun acc x -> List.fold_left ( fun acc y -> f acc x y) acc l2) acc l1 - let map2 f l1 l2 = List.concat ( - List.map (fun x -> - List.map (fun y -> f x y) l2) l1) + let map2 f l1 l2 = List.concat_map (fun x -> + List.map (fun y -> f x y) l2) l1 let map_find_opt (v,r) map = match TMap.find_opt v map with | None -> None From e342e38e3e389e520b84203bb45058d79b5d0290 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 24 May 2024 13:59:54 +0200 Subject: [PATCH 129/323] rename tests --- src/cdomains/congruenceClosure.ml | 2 +- src/goblint_lib.ml | 5 ++++- tests/regression/{79-wrpointer => 82-wrpointer}/01-simple.c | 0 .../{79-wrpointer => 82-wrpointer}/02-rel-simple.c | 0 .../{79-wrpointer => 82-wrpointer}/03-function-call.c | 0 .../{79-wrpointer => 82-wrpointer}/04-remove-vars.c | 0 tests/regression/{79-wrpointer => 82-wrpointer}/05-branch.c | 0 .../06-invertible-assignment.c | 0 .../07-invertible-assignment2.c | 0 .../{79-wrpointer => 82-wrpointer}/08-simple-assignment.c | 0 .../{79-wrpointer => 82-wrpointer}/09-different-offsets.c | 0 .../{79-wrpointer => 82-wrpointer}/10-different-types.c | 0 tests/regression/{79-wrpointer => 82-wrpointer}/11-array.c | 0 .../{79-wrpointer => 82-wrpointer}/12-rel-function.c | 0 .../{79-wrpointer => 82-wrpointer}/13-experiments.c | 0 tests/regression/{79-wrpointer => 82-wrpointer}/14-join.c | 0 .../{79-wrpointer => 82-wrpointer}/15-arrays-structs.c | 0 tests/regression/{79-wrpointer => 82-wrpointer}/16-loops.c | 0 tests/regression/{79-wrpointer => 82-wrpointer}/17-join2.c | 0 .../{79-wrpointer => 82-wrpointer}/18-complicated-join.c | 0 .../{79-wrpointer => 82-wrpointer}/19-disequalities.c | 0 .../{79-wrpointer => 82-wrpointer}/20-self-pointing-struct.c | 0 .../{79-wrpointer => 82-wrpointer}/21-global-var.c | 0 .../{79-wrpointer => 82-wrpointer}/22-join-diseq.c | 0 .../{79-wrpointer => 82-wrpointer}/23-function-deref.c | 0 .../{79-wrpointer => 82-wrpointer}/25-struct-circular.c | 0 tests/regression/{79-wrpointer => 82-wrpointer}/26-join3.c | 0 .../{79-wrpointer => 82-wrpointer}/27-join-diseq2.c | 0 28 files changed, 5 insertions(+), 2 deletions(-) rename tests/regression/{79-wrpointer => 82-wrpointer}/01-simple.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/02-rel-simple.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/03-function-call.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/04-remove-vars.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/05-branch.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/06-invertible-assignment.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/07-invertible-assignment2.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/08-simple-assignment.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/09-different-offsets.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/10-different-types.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/11-array.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/12-rel-function.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/13-experiments.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/14-join.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/15-arrays-structs.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/16-loops.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/17-join2.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/18-complicated-join.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/19-disequalities.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/20-self-pointing-struct.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/21-global-var.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/22-join-diseq.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/23-function-deref.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/25-struct-circular.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/26-join3.c (100%) rename tests/regression/{79-wrpointer => 82-wrpointer}/27-join-diseq2.c (100%) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index ae90a9b42c..a61a29591a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -729,7 +729,7 @@ module CongruenceClosure = struct fun acc y -> f acc x y) acc l2) acc l1 let map2 f l1 l2 = List.concat_map (fun x -> - List.map (fun y -> f x y) l2) l1 + List.map (fun y -> f x y) l2) l1 let map_find_opt (v,r) map = match TMap.find_opt v map with | None -> None diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 647b6a7d32..ca1a9c9388 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -81,6 +81,7 @@ module LinearTwoVarEqualityAnalysis = LinearTwoVarEqualityAnalysis module VarEq = VarEq module CondVars = CondVars module TmpSpecial = TmpSpecial +module StartStateAnalysis = StartStateAnalysis (** {2 Heap} @@ -221,7 +222,6 @@ module Mval = Mval module Offset = Offset module StringDomain = StringDomain module AddressDomain = AddressDomain -module WeaklyRelationalPointerDomain = WeaklyRelationalPointerDomain (** {5 Complex} *) @@ -274,6 +274,9 @@ module MusteqDomain = MusteqDomain module RegionDomain = RegionDomain module StackDomain = StackDomain +module CongruenceClosure = CongruenceClosure +module WeaklyRelationalPointerDomain = WeaklyRelationalPointerDomain + (** {2 Testing} Modules related to (property-based) testing of domains. *) diff --git a/tests/regression/79-wrpointer/01-simple.c b/tests/regression/82-wrpointer/01-simple.c similarity index 100% rename from tests/regression/79-wrpointer/01-simple.c rename to tests/regression/82-wrpointer/01-simple.c diff --git a/tests/regression/79-wrpointer/02-rel-simple.c b/tests/regression/82-wrpointer/02-rel-simple.c similarity index 100% rename from tests/regression/79-wrpointer/02-rel-simple.c rename to tests/regression/82-wrpointer/02-rel-simple.c diff --git a/tests/regression/79-wrpointer/03-function-call.c b/tests/regression/82-wrpointer/03-function-call.c similarity index 100% rename from tests/regression/79-wrpointer/03-function-call.c rename to tests/regression/82-wrpointer/03-function-call.c diff --git a/tests/regression/79-wrpointer/04-remove-vars.c b/tests/regression/82-wrpointer/04-remove-vars.c similarity index 100% rename from tests/regression/79-wrpointer/04-remove-vars.c rename to tests/regression/82-wrpointer/04-remove-vars.c diff --git a/tests/regression/79-wrpointer/05-branch.c b/tests/regression/82-wrpointer/05-branch.c similarity index 100% rename from tests/regression/79-wrpointer/05-branch.c rename to tests/regression/82-wrpointer/05-branch.c diff --git a/tests/regression/79-wrpointer/06-invertible-assignment.c b/tests/regression/82-wrpointer/06-invertible-assignment.c similarity index 100% rename from tests/regression/79-wrpointer/06-invertible-assignment.c rename to tests/regression/82-wrpointer/06-invertible-assignment.c diff --git a/tests/regression/79-wrpointer/07-invertible-assignment2.c b/tests/regression/82-wrpointer/07-invertible-assignment2.c similarity index 100% rename from tests/regression/79-wrpointer/07-invertible-assignment2.c rename to tests/regression/82-wrpointer/07-invertible-assignment2.c diff --git a/tests/regression/79-wrpointer/08-simple-assignment.c b/tests/regression/82-wrpointer/08-simple-assignment.c similarity index 100% rename from tests/regression/79-wrpointer/08-simple-assignment.c rename to tests/regression/82-wrpointer/08-simple-assignment.c diff --git a/tests/regression/79-wrpointer/09-different-offsets.c b/tests/regression/82-wrpointer/09-different-offsets.c similarity index 100% rename from tests/regression/79-wrpointer/09-different-offsets.c rename to tests/regression/82-wrpointer/09-different-offsets.c diff --git a/tests/regression/79-wrpointer/10-different-types.c b/tests/regression/82-wrpointer/10-different-types.c similarity index 100% rename from tests/regression/79-wrpointer/10-different-types.c rename to tests/regression/82-wrpointer/10-different-types.c diff --git a/tests/regression/79-wrpointer/11-array.c b/tests/regression/82-wrpointer/11-array.c similarity index 100% rename from tests/regression/79-wrpointer/11-array.c rename to tests/regression/82-wrpointer/11-array.c diff --git a/tests/regression/79-wrpointer/12-rel-function.c b/tests/regression/82-wrpointer/12-rel-function.c similarity index 100% rename from tests/regression/79-wrpointer/12-rel-function.c rename to tests/regression/82-wrpointer/12-rel-function.c diff --git a/tests/regression/79-wrpointer/13-experiments.c b/tests/regression/82-wrpointer/13-experiments.c similarity index 100% rename from tests/regression/79-wrpointer/13-experiments.c rename to tests/regression/82-wrpointer/13-experiments.c diff --git a/tests/regression/79-wrpointer/14-join.c b/tests/regression/82-wrpointer/14-join.c similarity index 100% rename from tests/regression/79-wrpointer/14-join.c rename to tests/regression/82-wrpointer/14-join.c diff --git a/tests/regression/79-wrpointer/15-arrays-structs.c b/tests/regression/82-wrpointer/15-arrays-structs.c similarity index 100% rename from tests/regression/79-wrpointer/15-arrays-structs.c rename to tests/regression/82-wrpointer/15-arrays-structs.c diff --git a/tests/regression/79-wrpointer/16-loops.c b/tests/regression/82-wrpointer/16-loops.c similarity index 100% rename from tests/regression/79-wrpointer/16-loops.c rename to tests/regression/82-wrpointer/16-loops.c diff --git a/tests/regression/79-wrpointer/17-join2.c b/tests/regression/82-wrpointer/17-join2.c similarity index 100% rename from tests/regression/79-wrpointer/17-join2.c rename to tests/regression/82-wrpointer/17-join2.c diff --git a/tests/regression/79-wrpointer/18-complicated-join.c b/tests/regression/82-wrpointer/18-complicated-join.c similarity index 100% rename from tests/regression/79-wrpointer/18-complicated-join.c rename to tests/regression/82-wrpointer/18-complicated-join.c diff --git a/tests/regression/79-wrpointer/19-disequalities.c b/tests/regression/82-wrpointer/19-disequalities.c similarity index 100% rename from tests/regression/79-wrpointer/19-disequalities.c rename to tests/regression/82-wrpointer/19-disequalities.c diff --git a/tests/regression/79-wrpointer/20-self-pointing-struct.c b/tests/regression/82-wrpointer/20-self-pointing-struct.c similarity index 100% rename from tests/regression/79-wrpointer/20-self-pointing-struct.c rename to tests/regression/82-wrpointer/20-self-pointing-struct.c diff --git a/tests/regression/79-wrpointer/21-global-var.c b/tests/regression/82-wrpointer/21-global-var.c similarity index 100% rename from tests/regression/79-wrpointer/21-global-var.c rename to tests/regression/82-wrpointer/21-global-var.c diff --git a/tests/regression/79-wrpointer/22-join-diseq.c b/tests/regression/82-wrpointer/22-join-diseq.c similarity index 100% rename from tests/regression/79-wrpointer/22-join-diseq.c rename to tests/regression/82-wrpointer/22-join-diseq.c diff --git a/tests/regression/79-wrpointer/23-function-deref.c b/tests/regression/82-wrpointer/23-function-deref.c similarity index 100% rename from tests/regression/79-wrpointer/23-function-deref.c rename to tests/regression/82-wrpointer/23-function-deref.c diff --git a/tests/regression/79-wrpointer/25-struct-circular.c b/tests/regression/82-wrpointer/25-struct-circular.c similarity index 100% rename from tests/regression/79-wrpointer/25-struct-circular.c rename to tests/regression/82-wrpointer/25-struct-circular.c diff --git a/tests/regression/79-wrpointer/26-join3.c b/tests/regression/82-wrpointer/26-join3.c similarity index 100% rename from tests/regression/79-wrpointer/26-join3.c rename to tests/regression/82-wrpointer/26-join3.c diff --git a/tests/regression/79-wrpointer/27-join-diseq2.c b/tests/regression/82-wrpointer/27-join-diseq2.c similarity index 100% rename from tests/regression/79-wrpointer/27-join-diseq2.c rename to tests/regression/82-wrpointer/27-join-diseq2.c From 534eb1177967d35c109d9dcb98902f63052761c5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 24 May 2024 15:34:49 +0200 Subject: [PATCH 130/323] added conf file for svcomp and fixed a bug --- conf/svcomp-wrpointer.json | 149 +++++++++++++++++++++++++++++ src/analyses/startStateAnalysis.ml | 2 +- 2 files changed, 150 insertions(+), 1 deletion(-) create mode 100644 conf/svcomp-wrpointer.json diff --git a/conf/svcomp-wrpointer.json b/conf/svcomp-wrpointer.json new file mode 100644 index 0000000000..f47b7aa5eb --- /dev/null +++ b/conf/svcomp-wrpointer.json @@ -0,0 +1,149 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "var_eq", + "symb_locks", + "region", + "thread", + "threadJoins", + "wrpointer", + "startState", + "taintPartialContexts" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": true, + "id": "enumerate", + "unknown": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "invariant_set" + ], + "invariant-types": [ + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": false, + "other": false, + "accessed": false, + "exact": true, + "exclude-vars": [ + "tmp\\(___[0-9]+\\)?", + "cond", + "RETURN", + "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", + ".*____CPAchecker_TMP_[0-9]+", + "__VERIFIER_assert__cond", + "__ksymtab_.*", + "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" + ] + } + }, + "pre": { + "enabled": false + } + } diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index d982885a2c..63e34149ba 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -38,7 +38,7 @@ struct | AddrOf (Var x, NoOffset) -> if x.vid < -1 then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty res;res) else Value.top() | _ -> Value.top () - let startcontext () = D.top () + let startcontext () = D.empty () let startstate v = D.bot () let exitstate = startstate From 5f0dbe536e6ad23ac184c82e7bd77910442b5631 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 10 Jun 2024 12:15:42 +0200 Subject: [PATCH 131/323] fixed invalid widen bug --- src/cdomains/congruenceClosure.ml | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index a61a29591a..0eccf025d5 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -916,6 +916,13 @@ module CongruenceClosure = struct | None -> Deref (t, z, T.dereference_exp exp z) | Some t -> t + let deref_term_even_if_its_not_possible min_term z set = + match deref_term min_term z set with + | result -> result + | exception (T.UnsupportedCilExpression _) -> + let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr and get_normal_form*) + Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z random_type, random_type)), NoOffset)) + end (** Minimal representatives map. @@ -946,11 +953,7 @@ module CongruenceClosure = struct let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in let next_min = - match (SSet.deref_term min_term Z.(edge_z - min_z) set, next_z) with - | exception (T.UnsupportedCilExpression _) -> - let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr*) - Deref (min_term, Z.(edge_z - min_z), Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant Z.(edge_z - min_z) random_type, random_type)), NoOffset)), next_z - | next_min -> next_min in + (SSet.deref_term_even_if_its_not_possible min_term Z.(edge_z - min_z) set, next_z) in match TMap.find_opt next_state min_representatives with | None -> @@ -1068,9 +1071,7 @@ module CongruenceClosure = struct List.filter_map (fun (z,s,_ (*size is not important for normal form?*),(s',z')) -> let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in - match normalize_equality (SSet.deref_term min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) with - | exception (T.UnsupportedCilExpression _) -> None - | eq -> eq + normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) ) transitions in (*disequalities*) let disequalities = Disequalities.get_disequalities cc.diseq @@ -1307,8 +1308,9 @@ module CongruenceClosure = struct (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = - let cc = insert_set_opt cc (fst (SSet.subterms_of_conj pos_conjs)) in - Option.map (fun cc -> closure cc pos_conjs) cc + let res = let cc = insert_set_opt cc (fst (SSet.subterms_of_conj pos_conjs)) in + Option.map (fun cc -> closure cc pos_conjs) cc + in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs = split conjs in From d09317711093c3991173b234f141bcf2cad4e601 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 11 Jun 2024 11:05:45 +0200 Subject: [PATCH 132/323] added constant bitsSizeOfPtr --- src/cdomains/congruenceClosure.ml | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index a61a29591a..83ad451596 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -7,6 +7,8 @@ module M = Messages exception Unsat +let bitsSizeOfPtr = Z.of_int @@ bitsSizeOf (TPtr (TVoid [],[])) + type ('v, 't) term = Addr of 'v | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t [@@deriving eq, ord, hash] @@ -205,7 +207,9 @@ module T = struct | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) in match typeOf res with (* we want to make sure that the expression is valid *) | exception GoblintCil__Errormsg.Error -> raise (UnsupportedCilExpression "this expression is not coherent") - | _ -> res + | typ -> (* we only track equalties between pointers (variable of size 64)*) + if get_size_in_bits typ <> bitsSizeOfPtr then raise (UnsupportedCilExpression "not a pointer variable") + else res let get_size = get_size_in_bits % type_of_term @@ -855,13 +859,13 @@ module CongruenceClosure = struct List.flatten % List.filter_map (fun (z, zmap) -> Option.map (fun l -> List.cartesian_product [z] (TSet.to_list l)) - (ZMap.find_opt (T.get_size_in_bits (TPtr (TVoid [], []))) zmap)) in + (ZMap.find_opt bitsSizeOfPtr zmap)) in let comp_closure_zmap bindings1 bindings2 = List.map (fun ((z1, nt1),(z2, nt2)) -> (nt1, nt2, Z.(-z2+z+z1))) (List.cartesian_product (find_size_64 bindings1) (find_size_64 bindings2)) in - let singleton term = [Z.zero, ZMap.add (Z.of_int 64) (TSet.singleton term) ZMap.empty] in + let singleton term = [Z.zero, ZMap.add bitsSizeOfPtr (TSet.singleton term) ZMap.empty] in begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with | None, None -> [(r1,r2,z)] | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) From d5b9b0310e6124243399a24dc0c3e2b33b88232b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 11 Jun 2024 11:23:05 +0200 Subject: [PATCH 133/323] check for each term, if it is a valid pointer --- src/cdomains/congruenceClosure.ml | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 3c597a82c8..4fb4ac1183 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -188,6 +188,13 @@ module T = struct | _ -> raise (UnsupportedCilExpression "not supported yet") end + let check_valid_pointer term = + match typeOf term with (* we want to make sure that the expression is valid *) + | exception GoblintCil__Errormsg.Error -> raise (UnsupportedCilExpression "this expression is not coherent") + | typ -> (* we only track equalties between pointers (variable of size 64)*) + if get_size_in_bits typ <> bitsSizeOfPtr then raise (UnsupportedCilExpression "not a pointer variable") + else term + let dereference_exp exp offset = let find_field cinfo = Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) in let res = match exp with @@ -205,11 +212,7 @@ module T = struct end | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) - in match typeOf res with (* we want to make sure that the expression is valid *) - | exception GoblintCil__Errormsg.Error -> raise (UnsupportedCilExpression "this expression is not coherent") - | typ -> (* we only track equalties between pointers (variable of size 64)*) - if get_size_in_bits typ <> bitsSizeOfPtr then raise (UnsupportedCilExpression "not a pointer variable") - else res + in check_valid_pointer res let get_size = get_size_in_bits % type_of_term @@ -295,12 +298,17 @@ module T = struct let of_cil_neg ask neg e = let res = match of_cil_neg ask neg (Cil.constFold false e) with | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; None, None - | t, z -> t, Some z + | None, z -> None, Some z + | Some t, z -> + (* check if t is a valid pointer *) + match check_valid_pointer (to_cil t) with + | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a\n%s --> %s + %s\n" d_plainexp e s (show t) (Z.to_string z); + None, None + | _ -> Some t, Some z in (if M.tracing && not neg then match res with | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) - | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z) - | None, None -> () - | _ -> M.trace "wrpointer-cil-conversion" "This is impossible. exp: %a\n" d_plainexp e); res + | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); + | _ -> ()); res let of_cil ask e = of_cil_neg ask false e From cf1869a9c9e2b675c60d57f4f7dffa549c247649 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 11 Jun 2024 12:25:19 +0200 Subject: [PATCH 134/323] remove types from data structure --- src/cdomains/congruenceClosure.ml | 197 +++++++++++++----------------- 1 file changed, 85 insertions(+), 112 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 4fb4ac1183..bc52cdb290 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -7,8 +7,6 @@ module M = Messages exception Unsat -let bitsSizeOfPtr = Z.of_int @@ bitsSizeOf (TPtr (TVoid [],[])) - type ('v, 't) term = Addr of 'v | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t [@@deriving eq, ord, hash] @@ -19,6 +17,9 @@ type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of (' *) module T = struct type exp = Cil.exp + + let bitsSizeOfPtr () = Z.of_int @@ bitsSizeOf (TPtr (TVoid [],[])) + (* equality of terms should not depend on the expression *) let compare_exp _ _ = 0 let equal_exp _ _ = true @@ -192,7 +193,7 @@ module T = struct match typeOf term with (* we want to make sure that the expression is valid *) | exception GoblintCil__Errormsg.Error -> raise (UnsupportedCilExpression "this expression is not coherent") | typ -> (* we only track equalties between pointers (variable of size 64)*) - if get_size_in_bits typ <> bitsSizeOfPtr then raise (UnsupportedCilExpression "not a pointer variable") + if get_size_in_bits typ <> bitsSizeOfPtr () then raise (UnsupportedCilExpression "not a pointer variable") else term let dereference_exp exp offset = @@ -547,8 +548,8 @@ end (** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a set containing all terms in the data structure that are equal to *(z + t').*) module LookupMap = struct - (* map: term -> z -> size of typ -> *(z + (typ * )t)*) - type t = TSet.t ZMap.t ZMap.t TMap.t [@@deriving eq, ord, hash] + (* map: term -> z -> *(z + (typ * )t)*) + type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings let add = TMap.add @@ -557,54 +558,41 @@ module LookupMap = struct let find_opt = TMap.find_opt let find = TMap.find - let zmap_bindings zmap = - let distribute_pair (a, xs) = List.map (fun (x,y) -> (a,x,y)) xs in - (List.concat_map distribute_pair - (List.map (Tuple2.map2 ZMap.bindings) (ZMap.bindings zmap))) - - let zmap_bindings_of_size s zmap = - List.filter_map (fun (off, zmap1) -> - Option.map (fun x -> (off, x)) @@ ZMap.find_opt s zmap1 - ) (ZMap.bindings zmap) + let zmap_bindings = ZMap.bindings (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). - It returns a list of (offset, size, term) *) - let zmap_bindings_one_successor (zmap:TSet.t ZMap.t ZMap.t) = - List.map (Tuple3.map3 TSet.any) (zmap_bindings zmap) - let zmap_find_opt t size = Option.map_default (ZMap.find_opt size) None % ZMap.find_opt t + It returns a list of (offset, term) *) + let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) + let zmap_find_opt = ZMap.find_opt let set_any = TSet.any - (** Merges the set "m" with the set that is already present in the data structure. - Params: x, size, set m, map.*) - let zmap_add x size y m = match ZMap.find_opt x m with - | None -> ZMap.add x (ZMap.add size y ZMap.empty) m - | Some zmap2 -> match ZMap.find_opt size zmap2 with - | None -> ZMap.add x (ZMap.add size y zmap2) m - | Some set -> ZMap.add x (ZMap.add size (TSet.union y set) zmap2) m + (** Merges the set "m" with the set that is already present in the data structure. *) + let zmap_add x y m = match zmap_find_opt x m with + | None -> ZMap.add x y m + | Some set -> ZMap.add x (TSet.union y set) m (** Returns the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt_set (v,r) size map = match find_opt v map with + let map_find_opt_set (v,r) map = match find_opt v map with | None -> None - | Some zmap -> zmap_find_opt r size zmap + | Some zmap -> zmap_find_opt r zmap (** Returns one element of the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt (v,r) size map = Option.map TSet.any (map_find_opt_set (v,r) size map) + let map_find_opt (v,r) map = Option.map TSet.any (map_find_opt_set (v,r) map) (** Adds the term "v'" to the set that is already present in the data structure. *) let map_add (v,r) v' map = - let size = T.get_size v' in let zmap = match find_opt v map with | None -> ZMap.empty | Some zmap -> zmap - in add v (zmap_add r size (TSet.singleton v') zmap) map + in add v (zmap_add r (TSet.singleton v') zmap) map let show_map map = List.fold_left (fun s (v, zmap) -> s ^ T.show v ^ "\t:\n" ^ List.fold_left - (fun s (r, size, v) -> - s ^ "\t" ^ Z.to_string r ^ "(" ^ Z.to_string size ^ "bits): " ^ List.fold_left + (fun s (r, v) -> + s ^ "\t" ^ Z.to_string r ^ ": " ^ List.fold_left (fun s k -> s ^ T.show k ^ ";") "" (TSet.elements v) ^ ";; ") "" (zmap_bindings zmap) ^ "\n") @@ -616,8 +604,8 @@ module LookupMap = struct match find_opt v' map with | None -> map | Some zmap -> let infl = zmap_bindings zmap in - let zmap = List.fold_left (fun zmap (r', s', v') -> - zmap_add Z.(r' + r) s' v' zmap) ZMap.empty infl in + let zmap = List.fold_left (fun zmap (r', v') -> + zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in remove v' (add v zmap map) (** Find all outgoing edges of v in the automata.*) @@ -629,18 +617,15 @@ module LookupMap = struct (** Filters elements from the mapped values which fulfil the predicate p. *) let filter_if map p = TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter_map (fun _ zmap2 -> - let zmap2 = ZMap.filter_map - (fun _ t_set -> let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) zmap2 - in if ZMap.is_empty zmap2 then None else Some zmap2) zmap - in if ZMap.is_empty zmap then None else Some zmap) - map + let zmap = ZMap.filter_map + (fun _ t_set -> let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) zmap + in if ZMap.is_empty zmap then None else Some zmap) map (** Maps elements from the mapped values by applying the function f to them. *) let map_values map f = TMap.map (fun zmap -> - ZMap.map (fun zmap2 -> ZMap.map (fun t_set -> TSet.map f t_set) zmap2) zmap) map + ZMap.map (fun t_set -> TSet.map f t_set) zmap) map end (** Quantitative congruence closure on terms *) @@ -652,11 +637,11 @@ module CongruenceClosure = struct module Disequalities = struct (* disequality map: - if t_1 -> z -> size of typ -> {t_2, t_3} - then we know that (typ)t_1 + z != (typ)t_2 - and also that (typ)t_1 + z != (typ)t_3 + if t_1 -> z -> {t_2, t_3} + then we know that t_1 + z != t_2 + and also that t_1 + z != t_3 *) - type t = TSet.t ZMap.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) + type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) let empty = TMap.empty @@ -664,14 +649,12 @@ module CongruenceClosure = struct (** Returns a list of tuples, which each represent a disequality *) let bindings = List.flatten % - List.flatten % - List.concat_map (fun (t, zmap) -> - List.map (fun (z, smap) -> - List.map (fun (size, tset) -> - List.map (fun term -> - (t,z,size,term)) (TSet.elements tset)) - (ZMap.bindings smap) - ) (ZMap.bindings zmap) + List.concat_map + (fun (t, smap) -> + List.map (fun (z, tset) -> + List.map (fun term -> + (t,z,term)) (TSet.elements tset)) + (ZMap.bindings smap) ) % TMap.bindings (** adds a mapping v -> r -> size -> { v' } to the map, @@ -684,14 +667,10 @@ module CongruenceClosure = struct | None -> false | Some imap -> (match ZMap.find_opt r imap with | None -> false - | Some imap -> - (let size = (T.get_size v') in - match ZMap.find_opt size imap with - | None -> false - | Some set -> TSet.mem v' set - ) + | Some set -> TSet.mem v' set ) + (** Map of partition, transform union find to a map of type V -> Z -> V set with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) @@ -703,9 +682,6 @@ module CongruenceClosure = struct ZMap.map (fun zmap -> List.fold_left (fun set (_,mapped) -> TSet.union set mapped) TSet.empty (ZMap.bindings zmap)) - let flatten_args = - ZMap.map (fun zmap -> List.fold_left - (fun set (_,mapped) -> set @ mapped) [] (ZMap.bindings zmap)) (** arg: maps each representative term t to a map that maps an integer Z to @@ -716,23 +692,16 @@ module CongruenceClosure = struct let get_args uf = let cmap = comp_map uf in let clist = TMap.bindings cmap in - let arg = List.fold_left (fun arg (v, imap) -> + let arg = List.fold_left (fun arg (v, imap) -> let ilist = ZMap.bindings imap in - let imap_sizes = flatten_args - (List.fold_left - (fun imap_sizes (size, map) -> - let iarg = List.fold_left (fun iarg (r,set) -> - let list = List.filter_map (function - | Deref (v',r',_) -> - let (v0,r0) = TUF.find_no_pc uf v' in - Some (v0,Z.(r0+r')) - | _ -> None) (TSet.elements set) in - ZMap.add r list iarg - ) ZMap.empty (ZMap.bindings map) in - ZMap.add size iarg imap_sizes) - ZMap.empty ilist) in - TMap.add v imap_sizes arg) - TMap.empty clist in + let iarg = List.fold_left (fun iarg (r,set) -> + let list = List.filter_map (function + | Deref (v', r', _) -> + let (v0,r0) = TUF.find_no_pc uf v' in + Some (v0,Z.(r0+r')) + | _ -> None) (TSet.elements set) in + ZMap.add r list iarg) ZMap.empty ilist in + TMap.add v iarg arg) TMap.empty clist in (uf,cmap,arg) let fold_left2 f acc l1 l2 = @@ -750,8 +719,7 @@ module CongruenceClosure = struct | Some v -> Some v ) - let check_neq (_,arg) rest (v,imapmap) = - let imap = flatten_map imapmap in + let check_neq (_,arg) rest (v,imap) = let ilist = ZMap.bindings imap in fold_left2 (fun rest (r1,_) (r2,_) -> if Z.equal r1 r2 then rest @@ -793,7 +761,7 @@ module CongruenceClosure = struct Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. *) - let rec propagate_neq (uf,cmap,arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) + let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) | (v1,v2,r) :: rest -> (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) if T.equal v1 v2 then (* should not happen *) @@ -840,7 +808,7 @@ module CongruenceClosure = struct let show_neq neq = let clist = bindings neq in - List.fold_left (fun s (v,r,size,v') -> + List.fold_left (fun s (v,r,v') -> s ^ "\t" ^ T.show v' ^ " != " ^ (if r = Z.zero then "" else (Z.to_string r) ^" + ") ^ T.show v ^ "\n") "" clist @@ -848,32 +816,27 @@ module CongruenceClosure = struct TMap.filter_map (fun _ zmap -> let zmap = ZMap.filter_map - (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ s -> let set = TSet.filter_map f s in - if TSet.is_empty set then None else Some set) - zmap in if ZMap.is_empty zmap then None else Some zmap) + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) zmap in if ZMap.is_empty zmap then None else Some zmap) diseq let get_disequalities = List.map - (fun (t1, z, _, t2) -> + (fun (t1, z, t2) -> Nequal (t1,t2,z) ) % bindings let element_closure diseqs uf = let cmap = comp_map uf in let comp_closure (r1,r2,z) = - let find_size_64 = (*TODO this is not the best solution*) - List.flatten % List.filter_map - (fun (z, zmap) -> Option.map - (fun l -> List.cartesian_product [z] (TSet.to_list l)) - (ZMap.find_opt bitsSizeOfPtr zmap)) in + let to_tuple_list = (*TODO this is not the best solution*) + List.flatten % List.map + (fun (z, set) -> List.cartesian_product [z] (TSet.to_list set)) in let comp_closure_zmap bindings1 bindings2 = List.map (fun ((z1, nt1),(z2, nt2)) -> (nt1, nt2, Z.(-z2+z+z1))) - (List.cartesian_product (find_size_64 bindings1) (find_size_64 bindings2)) + (List.cartesian_product (to_tuple_list bindings1) (to_tuple_list bindings2)) in - let singleton term = [Z.zero, ZMap.add bitsSizeOfPtr (TSet.singleton term) ZMap.empty] in + let singleton term = [Z.zero, TSet.singleton term] in begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with | None, None -> [(r1,r2,z)] | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) @@ -961,7 +924,7 @@ module CongruenceClosure = struct | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match LMap.successors state map with | edges -> - let process_edge (min_representatives, queue, uf) (edge_z, _(*min_repr is independent of the size*), next_term) = + let process_edge (min_representatives, queue, uf) (edge_z, next_term) = let next_state, next_z, uf = TUF.find uf next_term in let (min_term, min_z) = find state min_representatives in let next_min = @@ -1058,8 +1021,8 @@ module CongruenceClosure = struct (** Returns a list of all the transition that are present in the automata. *) let get_transitions (uf, map) = List.concat_map (fun (t, zmap) -> - (List.map (fun (edge_z, edge_size, res_t) -> - (edge_z, t, edge_size, TUF.find_no_pc uf (LMap.set_any res_t))) @@ + (List.map (fun (edge_z, res_t) -> + (edge_z, t, TUF.find_no_pc uf (LMap.set_any res_t))) @@ (LMap.zmap_bindings zmap))) (LMap.bindings map) @@ -1080,7 +1043,7 @@ module CongruenceClosure = struct in let conjunctions_of_transitions = let transitions = get_transitions (cc.uf, cc.map) in - List.filter_map (fun (z,s,_ (*size is not important for normal form?*),(s',z')) -> + List.filter_map (fun (z,s,(s',z')) -> let (min_state, min_z) = MRMap.find s cc.min_repr in let (min_state', min_z') = MRMap.find s' cc.min_repr in normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) @@ -1159,23 +1122,23 @@ module CongruenceClosure = struct (* zmap describes args of Deref *) let r0 = Z.(r2-r1+r) in (* difference between roots *) (* we move all entries of imap2 to imap1 *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings_of_size sizet1 imap2) in + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = match LMap.zmap_find_opt r' sizet1 zmap with + let rest = match LMap.zmap_find_opt r' zmap with | None -> rest | Some v'' -> (LMap.set_any v', LMap.set_any v'',Z.zero)::rest - in LMap.zmap_add r' sizet1 v' zmap, rest) + in LMap.zmap_add r' v' zmap, rest) (imap1,rest) infl2 in LMap.remove v2 (LMap.add v zmap map), rest | Some imap1, Some imap2, false -> (* v2 is new root *) let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings_of_size sizet1 imap1) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> let rest = - match LMap.zmap_find_opt r' sizet1 zmap with + match LMap.zmap_find_opt r' zmap with | None -> rest | Some v'' -> (LMap.set_any v',LMap.set_any v'',Z.zero)::rest - in LMap.zmap_add r' sizet1 v' zmap, rest) (imap2, rest) infl1 in + in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in LMap.remove v1 (LMap.add v zmap map), rest in (* update min_repr *) @@ -1251,7 +1214,7 @@ module CongruenceClosure = struct let (v, r), cc, queue = insert_no_min_repr cc t' in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - match LMap.map_find_opt (v, Z.(r + z)) (T.get_size_in_bits (typeOf exp)) cc.map with + match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in (v2,z2), closure {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq} [(t, v', Z.zero)], v::queue @@ -1299,10 +1262,20 @@ module CongruenceClosure = struct with Unsat -> None (** Returns true if t1 and t2 are equivalent. *) - let eq_query cc (t1,t2,r) = + let rec eq_query cc (t1,t2,r) = let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in - (T.equal v1 v2 && Z.equal r1 Z.(r2 + r), cc) + if T.equal v1 v2 && Z.equal r1 Z.(r2 + r) then (true, cc) + else + (*if the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, + i.e. if t1' + z1 = t2' + z2 *) + if Z.equal r Z.zero then + match t1,t2 with + | Deref (t1', z1, _), Deref (t2', z2, _) -> + eq_query cc (t1', t2', Z.(z2 - z1)) + | _ -> (false, cc) + else (false,cc) + let eq_query_opt cc (t1,t2,r) = match cc with @@ -1364,7 +1337,7 @@ module CongruenceClosure = struct detect_cyclic_dependencies t1 t2 cc let add_successor_terms cc t = - let add_one_successor (cc, successors) (edge_z, _, _) = + let add_one_successor (cc, successors) (edge_z, _) = let _, uf_offset, uf = TUF.find cc.uf t in let cc = {cc with uf = uf} in match SSet.deref_term t Z.(edge_z - uf_offset) cc.set with @@ -1541,9 +1514,9 @@ module CongruenceClosure = struct let pmap = List.fold_left (fun pmap (x1,x2) -> Map.add x1 x2 pmap) Map.empty mappings in let working_set = List.map fst mappings in let cc = init_cc [] in - let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, size, a) = + let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = let a', a_off = TUF.find_no_pc cc1.uf a in - match LMap.map_find_opt (y, Z.(diff + offset)) size cc2.map with + match LMap.map_find_opt (y, Z.(diff + offset)) cc2.map with | None -> pmap,cc,new_pairs | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in match SSet.deref_term t Z.(offset - t1_off) cc1.set with From 1ef4887334ec00c7488de0794d881ff1a803ac1b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 11 Jun 2024 14:04:35 +0200 Subject: [PATCH 135/323] check for propositions *x = *y if the pointers x and y are equal (such that it works even when x and y are pointers to int and we don't store equalities about ints) --- src/cdomains/congruenceClosure.ml | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index bc52cdb290..5436e79ee7 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -299,19 +299,23 @@ module T = struct let of_cil_neg ask neg e = let res = match of_cil_neg ask neg (Cil.constFold false e) with | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; None, None - | None, z -> None, Some z - | Some t, z -> - (* check if t is a valid pointer *) - match check_valid_pointer (to_cil t) with - | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a\n%s --> %s + %s\n" d_plainexp e s (show t) (Z.to_string z); - None, None - | _ -> Some t, Some z + | t, z -> t, Some z in (if M.tracing && not neg then match res with | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); | _ -> ()); res - let of_cil ask e = of_cil_neg ask false e + (** Convert the expression to a term, + and additionally check that the term is 64 bits *) + let of_cil ask e = + match of_cil_neg ask false e with + | Some t, Some z -> + (* check if t is a valid pointer *) + begin match check_valid_pointer (to_cil t) with + | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a\n%s --> %s + %s\n" d_plainexp e s (show t) (Z.to_string z); + None, None + | _ -> Some t, Some z end + | t, z -> t, z let map_z_opt op z = Tuple2.map2 (Option.map (op z)) @@ -322,7 +326,7 @@ module T = struct | BinOp (binop, exp1, exp2, typ)-> begin match binop with | PlusA | PlusPI - | IndexPI -> begin match of_cil ask exp1 with + | IndexPI -> begin match of_cil_neg ask false exp1 with | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask true exp2 in map_z_opt Z.(+) off1 pos_t, neg_t | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask true exp2 @@ -330,15 +334,15 @@ module T = struct end | MinusA | MinusPI - | MinusPP -> begin match of_cil ask exp1 with + | MinusPP -> begin match of_cil_neg ask false exp1 with | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask false exp2 in map_z_opt Z.(+) off1 pos_t, neg_t | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask false exp2 - | _ -> of_cil ask e, (None, Some Z.zero) + | _ -> of_cil_neg ask false e, (None, Some Z.zero) end - | _ -> of_cil ask e, (None, Some Z.zero) + | _ -> of_cil_neg ask false e, (None, Some Z.zero) end - | _ -> of_cil ask e, (None, Some Z.zero) + | _ -> of_cil_neg ask false e, (None, Some Z.zero) in if neg then neg_t, pos_t else pos_t, neg_t (** `prop_of_cil e pos` parses the expression `e` (or `not e` if `pos = false`) and From a06c9c9c618333e72d68ee4abbb338fc657c2646 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 11 Jun 2024 14:06:32 +0200 Subject: [PATCH 136/323] adapt test case to new type handling --- tests/regression/82-wrpointer/10-different-types.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/82-wrpointer/10-different-types.c b/tests/regression/82-wrpointer/10-different-types.c index 868b1a4d8e..522b6d45aa 100644 --- a/tests/regression/82-wrpointer/10-different-types.c +++ b/tests/regression/82-wrpointer/10-different-types.c @@ -7,7 +7,7 @@ void main(void) { int *ipt = (int *)malloc(sizeof(int)); int *ipt2; int i; - *ipt = i; + ipt = &i; // *ipt: 0; i: 0 __goblint_check(*ipt == i); ipt2 = (int *)ipt; From b49995dd0d98ffd4fa76d7d2b1af85b76cf3c5fb Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 12 Jun 2024 10:36:48 +0200 Subject: [PATCH 137/323] fix error: top of IntDomTuple not supported --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 5436e79ee7..e93b45bcb7 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -137,7 +137,7 @@ module T = struct | NoOffset -> `NoOffset | Field (fld, ofs) -> `Field (fld, convert_offset ofs) | Index (exp, ofs) when CilType.Exp.equal exp (Lazy.force Offset.Index.Exp.any) -> (* special offset added by convertToQueryLval *) - `Index (ValueDomain.ID.top (), convert_offset ofs) + `Index (ValueDomain.ID.top_of (Cilfacade.get_ikind_exp exp), convert_offset ofs) | Index (exp, ofs) -> let i = match ask.f (Queries.EvalInt exp) with | `Lifted x -> IntDomain.IntDomTuple.cast_to (Cilfacade.ptrdiff_ikind ()) @@ x From e48d0be03cac11fe524aa0c1ee23b182f6d7acf3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 12 Jun 2024 10:40:02 +0200 Subject: [PATCH 138/323] fix error: cil sizeoferror --- src/cdomains/congruenceClosure.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index e93b45bcb7..7e410fd60a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -47,6 +47,7 @@ module T = struct let props_equal = List.equal equal_v_prop let show_type exp = + try let typ = typeOf exp in "[" ^ (match typ with | TPtr _ -> "Ptr" @@ -57,6 +58,8 @@ module T = struct | TComp (_, _) -> "TCo" | TFun (_, _, _, _)|TNamed (_, _)|TEnum (_, _)|TBuiltin_va_list _ -> "?" )^string_of_int (bitsSizeOf typ) ^ "]" + with + | GoblintCil__Cil.SizeOfError _ -> "[?]" let rec show : t -> string = function | Addr v -> "&" ^ Var.show v From 966d6b397a0947b76a529946033d7ad50ef87af3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 12 Jun 2024 10:45:50 +0200 Subject: [PATCH 139/323] better way of fixing the error --- src/cdomains/congruenceClosure.ml | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7e410fd60a..20e5a1c5d1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -46,18 +46,23 @@ module T = struct let props_equal = List.equal equal_v_prop + let rec get_size_in_bits typ = match typ with + | TArray (typ, _, _) -> (* we treat arrays like pointers *) + get_size_in_bits (TPtr (typ,[])) + | _ -> Z.of_int (bitsSizeOf typ) + let show_type exp = try - let typ = typeOf exp in - "[" ^ (match typ with - | TPtr _ -> "Ptr" - | TInt _ -> "Int" - | TArray _ -> "Arr" - | TVoid _ -> "Voi" - | TFloat (_, _)-> "Flo" - | TComp (_, _) -> "TCo" - | TFun (_, _, _, _)|TNamed (_, _)|TEnum (_, _)|TBuiltin_va_list _ -> "?" - )^string_of_int (bitsSizeOf typ) ^ "]" + let typ = typeOf exp in + "[" ^ (match typ with + | TPtr _ -> "Ptr" + | TInt _ -> "Int" + | TArray _ -> "Arr" + | TVoid _ -> "Voi" + | TFloat (_, _)-> "Flo" + | TComp (_, _) -> "TCo" + | TFun (_, _, _, _)|TNamed (_, _)|TEnum (_, _)|TBuiltin_va_list _ -> "?" + )^ Z.to_string (get_size_in_bits typ) ^ "]" with | GoblintCil__Cil.SizeOfError _ -> "[?]" @@ -103,11 +108,6 @@ module T = struct | i -> Some i | exception (UnsupportedCilExpression _) -> None - let rec get_size_in_bits typ = match typ with - | TArray (typ, _, _) -> (* we treat arrays like pointers *) - get_size_in_bits (TPtr (typ,[])) - | _ -> Z.of_int (bitsSizeOf typ) - let rec type_of_element typ = match typ with | TArray (typ, _, _) -> type_of_element typ From a0d49ecc20f0ddd18345c1d634d39aa6eca81f1a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 12 Jun 2024 12:15:39 +0200 Subject: [PATCH 140/323] fix out of memory error. It was because I used < instead of T.compare --- src/cdomains/congruenceClosure.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 20e5a1c5d1..37fc45c3cc 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1151,7 +1151,7 @@ module CongruenceClosure = struct (* update min_repr *) let min_v1, min_v2 = MRMap.find v1 min_repr, MRMap.find v2 min_repr in (* 'changed' is true if the new_min is different than the old min *) - let new_min, changed = if fst min_v1 < fst min_v2 then (min_v1, not b) else (min_v2, b) in + let new_min, changed = if T.compare (fst min_v1) (fst min_v2) < 0 then (min_v1, not b) else (min_v2, b) in let new_min = (fst new_min, if b then Z.(snd new_min - diff_r) else Z.(snd new_min + diff_r)) in let removed_v = if b then v2 else v1 in let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in @@ -1353,7 +1353,7 @@ module CongruenceClosure = struct | successor -> let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] - else insert_no_min_repr cc successor in + else (if M.tracing then M.trace "wrpointer" "insert successor: %s. Map: %s\n" (T.show successor) (LMap.show_map cc.map);insert_no_min_repr cc successor) in (cc, if subterm_already_present then successors else successor::successors) in List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) @@ -1497,8 +1497,10 @@ module CongruenceClosure = struct (* first find all terms that need to be removed *) let set, removed_terms, map_of_children, cc = remove_terms_from_set cc predicate - in let uf, new_parents_map, _ = - remove_terms_from_uf cc.uf removed_terms map_of_children predicate + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + (show_all old_cc); + let uf, new_parents_map, _ = + remove_terms_from_uf cc.uf removed_terms map_of_children predicate in let map = remove_terms_from_mapped_values cc.map (predicate cc.uf) in let map, uf = From ccf43ba2500b4bf7dc30da3c1ddb2ee883d39d3a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 13 Jun 2024 12:28:17 +0200 Subject: [PATCH 141/323] fix error when there s an array of non-constant length --- src/cdomains/congruenceClosure.ml | 52 +++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 16 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 37fc45c3cc..a80930ebc6 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -148,7 +148,19 @@ module T = struct in `Index (i, convert_offset ofs) in - PreValueDomain.Offs.to_index ?typ:(Some typ) (convert_offset offs) + let to_constant exp = try let z = eval_int ask exp in + Const (CInt (z, Cilfacade.get_ikind_exp exp, Some (Z.to_string z))) + with Invalid_argument _ | UnsupportedCilExpression _ -> exp + in + let rec convert_type typ = (* compute length of arrays when it is known*) + match typ with + | TArray (typ, exp, attr) -> TArray (convert_type typ, Option.map to_constant exp, attr) + | TPtr (typ, attr) -> TPtr (convert_type typ, attr) + | TFun (typ, form, var_arg, attr) -> TFun (convert_type typ, form, var_arg, attr) + | TNamed (typeinfo, attr) -> TNamed ({typeinfo with ttype=convert_type typeinfo.ttype}, attr) + | TVoid _| TInt (_, _)| TFloat (_, _)| TComp (_, _)| TEnum (_, _)| TBuiltin_va_list _ -> typ + in + PreValueDomain.Offs.to_index ?typ:(Some (convert_type typ)) (convert_offset offs) let z_of_offset ask offs typ = match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with @@ -269,21 +281,29 @@ module T = struct | t, z -> t, z end | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") - and of_lval ask lval = let res = match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) - else of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) - | (Mem exp, off) -> - begin match of_cil ask exp with - | (Some term, offset) -> - let typ = typeOf exp in - if is_struct_ptr_type typ then - match of_offset ask term off typ (Lval lval) with - | Addr x -> Addr x - | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) - else - of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) - | _ -> raise (UnsupportedCilExpression "cannot dereference constant") - end in + and of_lval ask lval = + let res = + try + match lval with + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) + else of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) + | (Mem exp, off) -> + begin match of_cil ask exp with + | (Some term, offset) -> + let typ = typeOf exp in + if is_struct_ptr_type typ then + match of_offset ask term off typ (Lval lval) with + | Addr x -> Addr x + | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) + else + of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) + | _ -> raise (UnsupportedCilExpression "cannot dereference constant") + end + with + | GoblintCil__Cil.SizeOfError _ -> + (* There was an array of unknown length *) + raise (UnsupportedCilExpression "array non-constant length") + in (if M.tracing then match res with | exception (UnsupportedCilExpression s) -> M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s | t -> M.trace "wrpointer-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show t)) From 76fd7e825ddd42aecf7263518c06d04069187a93 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 13 Jun 2024 16:52:07 +0200 Subject: [PATCH 142/323] fixed bug with disequations --- src/cdomains/congruenceClosure.ml | 2 +- src/cdomains/weaklyRelationalPointerDomain.ml | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index a80930ebc6..e5518d3745 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1530,7 +1530,7 @@ module CongruenceClosure = struct in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) (show_all old_cc) (show_all {uf; set; map; min_repr; diseq}); - {uf; set; map; min_repr; diseq = cc.diseq} + {uf; set; map; min_repr; diseq} (* join *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 1550312cda..53f2c8729f 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -182,7 +182,6 @@ module D = struct let cc = Option.map (fun cc -> (snd(insert cc term))) cc in Option.map (remove_terms (fun uf -> MayBeEqual.may_be_equal ask uf s term)) cc - (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = From d10394bcd9c48216a92d80da3f1170a2663de16e Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 13 Jun 2024 19:07:35 +0200 Subject: [PATCH 143/323] fix sizeoferror and not_found error --- src/cdomains/congruenceClosure.ml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index e5518d3745..d253ea2ade 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -165,7 +165,10 @@ module T = struct let z_of_offset ask offs typ = match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i - | None -> raise (UnsupportedCilExpression "unknown offset") + | None + | exception GoblintCil__Cil.SizeOfError _ -> + (* there is an array for which we don't know the length *) + raise (UnsupportedCilExpression "unknown offset") let can_be_dereferenced = function | TPtr _| TArray _| TComp _ -> true @@ -212,7 +215,10 @@ module T = struct else term let dereference_exp exp offset = - let find_field cinfo = Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) in + let find_field cinfo = try + Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) + with | Not_found -> raise (UnsupportedCilExpression "invalid field offset") + in let res = match exp with | AddrOf lval -> Lval lval | _ -> From d46c5b35957ec1064f0b04eed090ab5ce4710f9a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 13 Jun 2024 21:43:24 +0200 Subject: [PATCH 144/323] fixed bug where the auxiliary variable is not completely removed from the domain --- src/analyses/weaklyRelationalPointerAnalysis.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 1fd8952d55..78e2bdde1d 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -65,7 +65,7 @@ struct t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable dummy_var + D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo (typeOfLval lval) (* invertibe assignment *) | exception (T.UnsupportedCilExpression _) -> D.top () (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. This should almost never happen. *) | _ -> D.top () From e8d9224e3cce0421823bb3bec643b31690ff2259 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 13 Jun 2024 21:45:15 +0200 Subject: [PATCH 145/323] fixed division by zero error and some wrong comparisons --- src/cdomains/congruenceClosure.ml | 11 +++++++---- src/cdomains/weaklyRelationalPointerDomain.ml | 4 ++-- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index d253ea2ade..62701a5fdf 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -186,7 +186,10 @@ module T = struct let default_int_type = ILong (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) - let to_cil_constant z t = let z = Z.(z/ get_element_size_in_bits t) in Const (CInt (z, default_int_type, Some (Z.to_string z))) + let to_cil_constant z t = + let typ_size = get_element_size_in_bits t in + let z = if Z.equal z Z.zero || Z.equal typ_size Z.zero then Z.zero else + Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) let to_cil_sum off cil_t = if Z.(equal zero off) then cil_t else @@ -786,7 +789,7 @@ module CongruenceClosure = struct List.filter_map (fun (v1,v2,r) -> let (v1,r1) = TUF.find_no_pc uf v1 in let (v2,r2) = TUF.find_no_pc uf v2 in - if T.compare v1 v2 = 0 then if r1 = Z.(r2+r) then raise Unsat + if T.equal v1 v2 then if Z.(equal r1 (r2+r)) then raise Unsat else None else Some (v1,v2,Z.(r2-r1+r))) neg @@ -822,7 +825,7 @@ module CongruenceClosure = struct with None -> [] | Some list -> list in fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if v1 = v2 then if r'1 = r'2 then raise Unsat + if T.equal v1 v2 then if Z.equal r'1 r'2 then raise Unsat else rest (* disequalities propagate only if the terms have same size*) else if Z.equal (T.get_size v1) (T.get_size v2) then @@ -842,7 +845,7 @@ module CongruenceClosure = struct let show_neq neq = let clist = bindings neq in List.fold_left (fun s (v,r,v') -> - s ^ "\t" ^ T.show v' ^ " != " ^ (if r = Z.zero then "" else (Z.to_string r) ^" + ") + s ^ "\t" ^ T.show v' ^ " != " ^ (if Z.equal r Z.zero then "" else (Z.to_string r) ^" + ") ^ T.show v ^ "\n") "" clist let filter_map f (diseq:t) = diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 53f2c8729f..f269f9a3ab 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -157,8 +157,8 @@ module D = struct It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show var); - Option.map (remove_terms (fun _ -> T.is_subterm var)) cc + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); + Option.map (remove_terms (fun _ -> T.is_subterm (Addr var))) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", From b7d8931f6c95f564074466212643b0de33003b7c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 17 Jun 2024 09:57:52 +0200 Subject: [PATCH 146/323] add small test for disequalities --- .../82-wrpointer/24-disequalities-small-example.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 tests/regression/82-wrpointer/24-disequalities-small-example.c diff --git a/tests/regression/82-wrpointer/24-disequalities-small-example.c b/tests/regression/82-wrpointer/24-disequalities-small-example.c new file mode 100644 index 0000000000..bad8fc0cb4 --- /dev/null +++ b/tests/regression/82-wrpointer/24-disequalities-small-example.c @@ -0,0 +1,12 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +int *a, b; +c() { b = 0; } +main() { + int *d; + if (a == d) + ; + else + __goblint_check(a != d); + c(); +} From 9dca5e1b32af0ef640768518a07c940717cdb639 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 17 Jun 2024 12:16:56 +0200 Subject: [PATCH 147/323] properly update the disequalities after a union operation. Use the min_repr instead of the representatives in order to represent the disequalities in the normal form. --- .../weaklyRelationalPointerAnalysis.ml | 17 +- src/cdomains/congruenceClosure.ml | 161 ++++++++++-------- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 3 files changed, 96 insertions(+), 84 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 78e2bdde1d..f9fb1fab66 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -29,16 +29,13 @@ struct and Some false if we know for sure that it is false, and None if we don't know anyhing. *) let eval_guard ask t e = - match t with - None -> Some false - | Some t -> - let prop_list = T.prop_of_cil ask e true in - let res = match split prop_list with - | [], [] -> None - | x::xs, _ -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None - | _, y::ys -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None - in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" - d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res + let prop_list = T.prop_of_cil ask e true in + let res = match split prop_list with + | [], [] -> None + | x::xs, _ -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None + | _, y::ys -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None + in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" + d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 62701a5fdf..cfb0597d32 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -755,8 +755,8 @@ module CongruenceClosure = struct | Some v -> Some v ) - let check_neq (_,arg) rest (v,imap) = - let ilist = ZMap.bindings imap in + let check_neq (_,arg) rest (v,zmap) = + let zlist = ZMap.bindings zmap in fold_left2 (fun rest (r1,_) (r2,_) -> if Z.equal r1 r2 then rest else (* r1 <> r2 *) @@ -772,7 +772,7 @@ module CongruenceClosure = struct then raise Unsat else rest else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 - ) rest ilist ilist + ) rest zlist zlist (** Initialize the list of disequalities taking only implicit dis-equalities into account. @@ -1085,8 +1085,14 @@ module CongruenceClosure = struct normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) ) transitions in (*disequalities*) - let disequalities = Disequalities.get_disequalities cc.diseq - in BatList.sort_unique (T.compare_v_prop)(conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities) + let disequalities = Disequalities.get_disequalities cc.diseq in + (* find disequalities between min_repr *) + let normalize_disequality (t1, t2, z) = + let (min_state1, min_z1) = MRMap.find t1 cc.min_repr in + let (min_state2, min_z2) = MRMap.find t2 cc.min_repr + in Nequal (min_state1, min_state2, Z.(z - (min_z1 - min_z2))) in (*TODO + o - *) + let disequalities = List.map (function | Equal (t1,t2,z)| Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)) disequalities + in BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities) let show_all x = "Normal form:\n" ^ show_conj((get_normal_form x)) ^ @@ -1101,6 +1107,12 @@ module CongruenceClosure = struct ^ "\nNeq:\n" ^ (Disequalities.show_neq x.diseq) + (** Splits the conjunction into two groups: the first one contains all equality propositions, + and the second one contains all inequality propositions. *) + let split conj = List.fold_left (fun (pos,neg) -> function + | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg) + | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj + (** returns {uf, set, map, min_repr}, where: @@ -1119,8 +1131,24 @@ module CongruenceClosure = struct let min_repr = MRMap.initial_minimal_representatives set in {uf; set; map; min_repr; diseq = Disequalities.empty} + (** closure of disequalities *) + let congruence_neq cc neg = + try + let neg = snd(split(Disequalities.get_disequalities cc.diseq)) @ neg in + (* getting args of dereferences *) + let uf,cmap,arg = Disequalities.get_args cc.uf in + (* taking implicit dis-equalities into account *) + let neq_list = Disequalities.init_neq (uf,cmap,arg) in + let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) neq_list in + (* taking explicit dis-equalities into account *) + let neq_list = Disequalities.init_list_neq uf neg in + let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in + if M.tracing then M.trace "wrpointer-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); + Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq} + with Unsat -> None + (** - parameters: (uf, map) equalities. + parameters: (uf, map) equalities. returns updated (uf, map, queue), where: @@ -1204,29 +1232,26 @@ module CongruenceClosure = struct Throws "Unsat" if a contradiction is found. *) let closure cc conjs = - let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in - (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) - let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in - if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); - {uf; set = cc.set; map; min_repr; diseq = cc.diseq} - - (** Splits the conjunction into two groups: the first one contains all equality propositions, - and the second one contains all inequality propositions. *) - let split conj = List.fold_left (fun (pos,neg) -> function - | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg) - | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj + match cc with + | None -> None + | Some cc -> + let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in + (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) + let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in + if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq} [] (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = let cc = init_cc conj in (* propagating equalities through derefs *) - closure cc conj + closure (Some cc) conj (** Returns None if the congruence is unsatisfiable.*) let init_congruence_opt conj = let cc = init_cc conj in (* propagating equalities through derefs *) - match closure cc conj with + match closure (Some cc) conj with | exception Unsat -> None | x -> Some x @@ -1239,63 +1264,50 @@ module CongruenceClosure = struct let rec insert_no_min_repr cc t = if SSet.mem t cc.set then let v,z,uf = TUF.find cc.uf t in - (v,z), {cc with uf}, [] + (v,z), Some {cc with uf}, [] else match t with | Addr a -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), {uf; set; map = cc.map; min_repr; diseq = cc.diseq}, [Addr a] + (t, Z.zero), Some {uf; set; map = cc.map; min_repr; diseq = cc.diseq}, [Addr a] | Deref (t', z, exp) -> - let (v, r), cc, queue = insert_no_min_repr cc t' in - let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in - let set = SSet.add t cc.set in - match LMap.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in - let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq} [(t, v', Z.zero)], v::queue - | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in - let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), {uf; set; map; min_repr; diseq = cc.diseq}, v::queue + match insert_no_min_repr cc t' with + | (v, r), None, queue -> (v, r), None, [] + | (v, r), Some cc, queue -> + let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in + let set = SSet.add t cc.set in + match LMap.map_find_opt (v, Z.(r + z)) cc.map with + | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in + let uf = LMap.add t ((t, Z.zero),1) uf in + (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq}) [(t, v', Z.zero)], v::queue + | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in + let uf = LMap.add t ((t, Z.zero),1) cc.uf in + (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq}, v::queue (** Add a term to the data structure. Returns (reference variable, offset), updated (uf, set, map, min_repr) *) let insert cc t = - let v, cc, queue = insert_no_min_repr cc t in - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - v, {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} - - (** Add all terms in a specific set to the data structure. - - Returns updated (uf, set, map, min_repr). *) - let insert_set t_set cc = - let cc, queue = SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = (insert_no_min_repr cc t) in (cc, queue @ a_queue) ) t_set (cc, []) in - (* update min_repr at the end for more efficiency *) - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} + match cc with + | None -> (t, Z.zero), None + | Some cc -> + match insert_no_min_repr cc t with + | v, None, queue -> v, None + | v, Some cc, queue -> + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in + v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} (** Add all terms in a specific set to the data structure. Returns updated (uf, set, map, min_repr). *) - let insert_set_opt cc t_set = - Option.map (insert_set t_set) cc - - (** used by NEQ *) - let congruence_neq cc neg = - match insert_set_opt (Some cc) (fst (SSet.subterms_of_conj neg)) with - | None -> None - | Some cc -> try - (* getting args of dereferences *) - let uf,cmap,arg = Disequalities.get_args cc.uf in - (* taking implicit dis-equalities into account *) - let neq_list = Disequalities.init_neq (uf,cmap,arg) in - let neq = Disequalities.propagate_neq (uf,cmap,arg,cc.diseq) neq_list in - (* taking explicit dis-equalities into account *) - let neq_list = Disequalities.init_list_neq uf neg in - let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in - Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq} - with Unsat -> None + let insert_set cc t_set = + match SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = Option.map_default (fun cc -> insert_no_min_repr cc t) ((t, Z.zero), None, []) cc in (cc, queue @ a_queue) ) t_set (cc, []) with + | None, queue -> None + | Some cc, queue -> + (* update min_repr at the end for more efficiency *) + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in + Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} (** Returns true if t1 and t2 are equivalent. *) let rec eq_query cc (t1,t2,r) = @@ -1312,7 +1324,6 @@ module CongruenceClosure = struct | _ -> (false, cc) else (false,cc) - let eq_query_opt cc (t1,t2,r) = match cc with | None -> false @@ -1325,17 +1336,19 @@ module CongruenceClosure = struct if T.equal v1 v2 then if Z.(equal r1 (r2 + r)) then false else true - else Disequalities.map_set_mem (v1,Z.(r2-r1+r)) v2 cc.diseq + else match cc with + | None -> true + | Some cc -> Disequalities.map_set_mem (v1,Z.(r2-r1+r)) v2 cc.diseq (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = - let res = let cc = insert_set_opt cc (fst (SSet.subterms_of_conj pos_conjs)) in - Option.map (fun cc -> closure cc pos_conjs) cc + let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in + closure cc pos_conjs in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs = split conjs in - match meet_conjs cc pos_conjs with + match insert_set (meet_conjs cc pos_conjs) (fst (SSet.subterms_of_conj neg_conjs)) with | exception Unsat -> None | Some cc -> congruence_neq cc neg_conjs | None -> None @@ -1382,7 +1395,7 @@ module CongruenceClosure = struct | successor -> let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] - else (if M.tracing then M.trace "wrpointer" "insert successor: %s. Map: %s\n" (T.show successor) (LMap.show_map cc.map);insert_no_min_repr cc successor) in + else (if M.tracing then M.trace "wrpointer" "insert successor: %s. Map: %s\n" (T.show successor) (LMap.show_map cc.map); Tuple3.map2 Option.get (insert_no_min_repr cc successor)) in (cc, if subterm_already_present then successors else successor::successors) in List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) @@ -1516,7 +1529,8 @@ module CongruenceClosure = struct -> change terms to their new representatives or remove them, if the representative class was completely removed. *) let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (LMap.filter_if diseq (not % predicate)) in (* modify left hand side of map *) - remove_terms_from_map (uf, diseq) removed_terms new_parents_map + let res, uf = remove_terms_from_map (uf, diseq) removed_terms new_parents_map in + if M.tracing then M.trace "wrpointer-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (Disequalities.show_neq res) (TUF.show_uf uf); res, uf (** Remove terms from the data structure. It removes all terms for which "predicate" is false, @@ -1574,7 +1588,7 @@ module CongruenceClosure = struct let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off diff) (pmap, cc, []) (LMap.successors x cc1.map) in add_edges_to_map pmap cc (rest@new_pairs) in - add_edges_to_map pmap cc working_set + add_edges_to_map pmap (Some cc) working_set (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) let join_neq diseq1 diseq2 cc1 cc2 cc = @@ -1582,9 +1596,10 @@ module CongruenceClosure = struct let _,diseq2 = split (Disequalities.get_disequalities diseq2) in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (neq_query cc2) (Disequalities.element_closure diseq1 cc1.uf) in - let diseq2 = List.filter (neq_query cc1) (Disequalities.element_closure diseq2 cc2.uf) in - let cc = insert_set (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2)) cc in - congruence_neq cc (diseq1 @ diseq2) + let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cc1.uf) in + let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cc2.uf) in + let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in + let res = congruence_neq cc (diseq1 @ diseq2) + in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n; Union find: %s\n" (Disequalities.show_neq r.diseq) (TUF.show_uf r.uf)| None -> ()); res end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index f269f9a3ab..9f006e165e 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -179,7 +179,7 @@ module D = struct It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); - let cc = Option.map (fun cc -> (snd(insert cc term))) cc in + let cc = snd (insert cc term) in Option.map (remove_terms (fun uf -> MayBeEqual.may_be_equal ask uf s term)) cc (** Remove terms from the data structure. From a0fd9a213c0652f2c8d18bf5bab1800fd2ca5cac Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 17 Jun 2024 14:38:19 +0200 Subject: [PATCH 148/323] solved last remaining SizeOfErrors --- .../weaklyRelationalPointerAnalysis.ml | 13 +++-- src/cdomains/congruenceClosure.ml | 50 ++++++++----------- 2 files changed, 30 insertions(+), 33 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index f9fb1fab66..43c6a45d4e 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -51,12 +51,11 @@ struct | _ -> Result.top q let assign_lval t ask lval expr = - let s = T.get_element_size_in_bits (typeOfLval lval) in - match T.of_lval ask lval, T.of_cil ask expr with + match T.get_element_size_in_bits (typeOfLval lval), T.of_lval ask lval, T.of_cil ask expr with (* Indefinite assignment *) - | lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t + | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t (* Definite assignment *) - | lterm, (Some term, Some offset) -> + | s, lterm, (Some term, Some offset) -> let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> @@ -64,7 +63,11 @@ struct meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo (typeOfLval lval) (* invertibe assignment *) - | exception (T.UnsupportedCilExpression _) -> D.top () (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. This should almost never happen. *) + | exception (T.UnsupportedCilExpression _) -> D.top () + (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. + We have to forget all the information we had. + This should almost never happen. + Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) | _ -> D.top () let assign ctx lval expr = diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index cfb0597d32..b72e01beeb 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -46,10 +46,14 @@ module T = struct let props_equal = List.equal equal_v_prop + exception UnsupportedCilExpression of string + let rec get_size_in_bits typ = match typ with | TArray (typ, _, _) -> (* we treat arrays like pointers *) get_size_in_bits (TPtr (typ,[])) - | _ -> Z.of_int (bitsSizeOf typ) + | _ -> match Z.of_int (bitsSizeOf typ) with + | exception GoblintCil__Cil.SizeOfError (msg,_) -> raise (UnsupportedCilExpression msg) + | s -> s let show_type exp = try @@ -64,7 +68,7 @@ module T = struct | TFun (_, _, _, _)|TNamed (_, _)|TEnum (_, _)|TBuiltin_va_list _ -> "?" )^ Z.to_string (get_size_in_bits typ) ^ "]" with - | GoblintCil__Cil.SizeOfError _ -> "[?]" + | UnsupportedCilExpression _ -> "[?]" let rec show : t -> string = function | Addr v -> "&" ^ Var.show v @@ -87,8 +91,6 @@ module T = struct let term_of_varinfo vinfo = Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) - exception UnsupportedCilExpression of string - let eval_int (ask:Queries.ask) exp = match Cilfacade.get_ikind_exp exp with | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") @@ -165,10 +167,7 @@ module T = struct let z_of_offset ask offs typ = match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i - | None - | exception GoblintCil__Cil.SizeOfError _ -> - (* there is an array for which we don't know the length *) - raise (UnsupportedCilExpression "unknown offset") + | None -> raise (UnsupportedCilExpression "unknown offset") let can_be_dereferenced = function | TPtr _| TArray _| TComp _ -> true @@ -292,26 +291,21 @@ module T = struct | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") and of_lval ask lval = let res = - try - match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) - else of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) - | (Mem exp, off) -> - begin match of_cil ask exp with - | (Some term, offset) -> - let typ = typeOf exp in - if is_struct_ptr_type typ then - match of_offset ask term off typ (Lval lval) with - | Addr x -> Addr x - | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) - else - of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) - | _ -> raise (UnsupportedCilExpression "cannot dereference constant") - end - with - | GoblintCil__Cil.SizeOfError _ -> - (* There was an array of unknown length *) - raise (UnsupportedCilExpression "array non-constant length") + match lval with + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) + else of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) + | (Mem exp, off) -> + begin match of_cil ask exp with + | (Some term, offset) -> + let typ = typeOf exp in + if is_struct_ptr_type typ then + match of_offset ask term off typ (Lval lval) with + | Addr x -> Addr x + | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) + else + of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) + | _ -> raise (UnsupportedCilExpression "cannot dereference constant") + end in (if M.tracing then match res with | exception (UnsupportedCilExpression s) -> M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s From 061f2b66e48076c144eefd786a9fc8d89c6ca44e Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 17 Jun 2024 16:56:55 +0200 Subject: [PATCH 149/323] use correct compare function --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b72e01beeb..9b78dc308b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -86,7 +86,7 @@ module T = struct | Deref (t, _, _) -> get_var t (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) - let rec contains_variable variables term = List.mem (get_var term) variables + let rec contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables let term_of_varinfo vinfo = Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) From fd95f86cb0256150b7d44f1bd5c0f5643e1b82f0 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 17 Jun 2024 18:42:14 +0200 Subject: [PATCH 150/323] add regressio test for the compare function bug --- tests/regression/82-wrpointer/28-return-value.c | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 tests/regression/82-wrpointer/28-return-value.c diff --git a/tests/regression/82-wrpointer/28-return-value.c b/tests/regression/82-wrpointer/28-return-value.c new file mode 100644 index 0000000000..10087d3485 --- /dev/null +++ b/tests/regression/82-wrpointer/28-return-value.c @@ -0,0 +1,16 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +int a, b, c; +void *d(const *e) { return e + 200; } +int *f() {} +main() { + g(a, c, b); + if (0) { + __goblint_check(0); // NOWARN (unreachable) + } + __goblint_check(1); // reachable +} +g(int, struct h *, struct i *) { + int *j = f(); + d(j); + __goblint_check(1); // reachable +} From 8fed9409fcf40528066a260480f7a7d53550ab25 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 18 Jun 2024 11:07:23 +0200 Subject: [PATCH 151/323] fixed inconsistency in disequalities --- src/cdomains/congruenceClosure.ml | 19 +++++++++++-------- tests/regression/82-wrpointer/22-join-diseq.c | 10 +++++----- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9b78dc308b..03e870fa1a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -797,7 +797,7 @@ module CongruenceClosure = struct if T.equal v1 v2 then (* should not happen *) if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) rest else (* check whether it is already in neq *) - if map_set_mem (v1,r) v2 neq then propagate_neq (uf,cmap,arg,neq) rest + if map_set_mem (v1,Z.(-r)) v2 neq then propagate_neq (uf,cmap,arg,neq) rest else let neq = map_set_add (v1,Z.(-r)) v2 neq |> map_set_add (v2,r) v1 in (* @@ -839,7 +839,7 @@ module CongruenceClosure = struct let show_neq neq = let clist = bindings neq in List.fold_left (fun s (v,r,v') -> - s ^ "\t" ^ T.show v' ^ " != " ^ (if Z.equal r Z.zero then "" else (Z.to_string r) ^" + ") + s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " ^ T.show v ^ "\n") "" clist let filter_map f (diseq:t) = @@ -852,7 +852,7 @@ module CongruenceClosure = struct let get_disequalities = List.map (fun (t1, z, t2) -> - Nequal (t1,t2,z) + Nequal (t1,t2,Z.(-z)) ) % bindings let element_closure diseqs uf = @@ -1083,9 +1083,12 @@ module CongruenceClosure = struct (* find disequalities between min_repr *) let normalize_disequality (t1, t2, z) = let (min_state1, min_z1) = MRMap.find t1 cc.min_repr in - let (min_state2, min_z2) = MRMap.find t2 cc.min_repr - in Nequal (min_state1, min_state2, Z.(z - (min_z1 - min_z2))) in (*TODO + o - *) - let disequalities = List.map (function | Equal (t1,t2,z)| Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)) disequalities + let (min_state2, min_z2) = MRMap.find t2 cc.min_repr in + let new_offset = Z.(min_z2 - min_z1 + z) in + if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) + else Nequal (min_state2, min_state1, Z.(-new_offset)) + in + let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)) disequalities in BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities) let show_all x = "Normal form:\n" ^ @@ -1332,7 +1335,7 @@ module CongruenceClosure = struct else true else match cc with | None -> true - | Some cc -> Disequalities.map_set_mem (v1,Z.(r2-r1+r)) v2 cc.diseq + | Some cc -> Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = @@ -1594,6 +1597,6 @@ module CongruenceClosure = struct let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cc2.uf) in let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in let res = congruence_neq cc (diseq1 @ diseq2) - in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n; Union find: %s\n" (Disequalities.show_neq r.diseq) (TUF.show_uf r.uf)| None -> ()); res + in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res end diff --git a/tests/regression/82-wrpointer/22-join-diseq.c b/tests/regression/82-wrpointer/22-join-diseq.c index 52bb1b3499..97c273b65b 100644 --- a/tests/regression/82-wrpointer/22-join-diseq.c +++ b/tests/regression/82-wrpointer/22-join-diseq.c @@ -13,24 +13,24 @@ void main(void) { int top; - if (a != b && e != c && c != d) { - __goblint_check(a != b); + if (a != b + 4 && e != c && c != d) { + __goblint_check(a != b + 4); __goblint_check(e != c); __goblint_check(c != d); if (top) { d = unknown; - __goblint_check(a != b); + __goblint_check(a != b + 4); __goblint_check(e != c); __goblint_check(c != d); // UNKNOWN! } else { e = unknown; - __goblint_check(a != b); + __goblint_check(a != b + 4); __goblint_check(e != c); // UNKNOWN! __goblint_check(c != d); } // JOIN - __goblint_check(a != b); + __goblint_check(a != b + 4); __goblint_check(e != c); // UNKNOWN! __goblint_check(c != d); // UNKNOWN! } From 83bb4cf32ae0aca897d8f505f556af1d83796fa5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 18 Jun 2024 11:07:50 +0200 Subject: [PATCH 152/323] removed warning for Field on a non-compound --- src/cdomains/congruenceClosure.ml | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 03e870fa1a..1533cd59aa 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -200,14 +200,21 @@ module T = struct | Some i -> i | None -> raise (UnsupportedCilExpression "unknown offset") + let is_field = function + | Field _ -> true + | _ -> false + let rec add_index_to_exp exp index = - begin match exp with - | Lval (Var v, NoOffset) -> Lval (Var v, index) - | Lval (Mem v, NoOffset) -> Lval (Mem v, index) - | BinOp (PlusPI, exp1, Const (CInt (z, _ , _ )), _)when Z.equal z Z.zero -> - add_index_to_exp exp1 index - | _ -> raise (UnsupportedCilExpression "not supported yet") - end + try if is_struct_type (typeOf exp) || not (is_field index) then + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | BinOp (PlusPI, exp1, Const (CInt (z, _ , _ )), _)when Z.equal z Z.zero -> + add_index_to_exp exp1 index + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + else raise (UnsupportedCilExpression "Field on a non-compound") + with | Cilfacade.TypeOfError _ -> raise (UnsupportedCilExpression "typeOf error") let check_valid_pointer term = match typeOf term with (* we want to make sure that the expression is valid *) From 0c41a16c9429174bf5e3652f58dba3832a867f4f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 18 Jun 2024 12:24:08 +0200 Subject: [PATCH 153/323] fix issue where startstate answers queries about variables that were not created by wrpointer --- src/analyses/startStateAnalysis.ml | 10 ++++++---- src/analyses/weaklyRelationalPointerAnalysis.ml | 4 ++-- src/cdomains/weaklyRelationalPointerDomain.ml | 4 ++-- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 63e34149ba..805c1a3878 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -21,9 +21,11 @@ struct include Analyses.IdentitySpec - let duplicated_variable var = { var with vid = - var.vid - 4; vname = var.vname ^ "'" } - let original_variable var = { var with vid = - (var.vid + 4); vname = String.rchop var.vname } - let return_varinfo = {dummyFunDec.svar with vid=(-2);vname="@return"} + let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } + let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } + let return_varinfo = {dummyFunDec.svar with vid=(-2);vname="wrpointer__@return"} + let is_wrpointer_ghost_variable x = x.vid < 0 && String.starts_with x.vname "wrpointer__" + let get_value (ask: Queries.ask) exp = ask.f (MayPointTo exp) @@ -35,7 +37,7 @@ struct | Some v -> if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v | None -> Value.top() end - | AddrOf (Var x, NoOffset) -> if x.vid < -1 then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty res;res) else Value.top() + | AddrOf (Var x, NoOffset) -> if is_wrpointer_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "wrpointer-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() | _ -> Value.top () let startcontext () = D.empty () diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 43c6a45d4e..915848c744 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -106,8 +106,8 @@ struct branch ctx exp true | _, _ -> ctx.local - let duplicated_variable var = { var with vid = - var.vid - 4; vname = var.vname ^ "'" } - let original_variable var = { var with vid = - (var.vid + 4); vname = String.rchop var.vname } + let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } + let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } (*First all local variables of the function are duplicated (by negating their ID), then we remember the value of each local variable at the beginning of the function diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 9f006e165e..0b5b2234af 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -12,11 +12,11 @@ module T = CC.T module MayBeEqual = struct module AD = ValueDomain.AD - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ} + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} let dummy_var var = T.term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="@return"} + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} let return_var var = T.term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) From b4b671232d124f4c65fbfa5125584537814c7c2c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 18 Jun 2024 12:26:14 +0200 Subject: [PATCH 154/323] I'm not sure what to write for the thread functions --- src/analyses/weaklyRelationalPointerAnalysis.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 915848c744..30bdf4faec 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -16,8 +16,6 @@ struct let name () = "wrpointer" let startcontext () = D.empty () - let startstate v = D.empty() - let exitstate v = D.empty() (* find reachable variables in a function *) let reachable_from_args ctx args = @@ -157,8 +155,10 @@ struct D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t - let threadenter ctx ~multiple var_opt v exprs = [ctx.local] - let threadspawn ctx ~multiple var_opt v exprs ctx2 = ctx.local + let startstate v = D.top () + let threadenter ctx ~multiple lval f args = [D.top ()] + let threadspawn ctx ~multiple lval f args fctx = D.top() + let exitstate v = D.top () end From 101e247b8bf0defb70e164216d44c543462f09a8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 18 Jun 2024 12:45:50 +0200 Subject: [PATCH 155/323] catch sizeOfError --- src/cdomains/congruenceClosure.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 1533cd59aa..007f3404c4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -167,7 +167,8 @@ module T = struct let z_of_offset ask offs typ = match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i - | None -> raise (UnsupportedCilExpression "unknown offset") + | None + | exception (SizeOfError _) -> raise (UnsupportedCilExpression "unknown offset") let can_be_dereferenced = function | TPtr _| TArray _| TComp _ -> true From 0182296c1b5ddc294f4a004a91e31b68975233b3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 18 Jun 2024 14:56:17 +0200 Subject: [PATCH 156/323] made Lookup Map with just one successor, as it was in the beginning --- src/cdomains/congruenceClosure.ml | 85 +++++++++++++++---------------- 1 file changed, 40 insertions(+), 45 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 007f3404c4..47ef271234 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -583,11 +583,10 @@ module ZMap = struct let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 end -(** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a set containing - all terms in the data structure that are equal to *(z + t').*) +(** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a term in the data structure that is equal to *(z + t').*) module LookupMap = struct - (* map: term -> z -> *(z + (typ * )t)*) - type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] + (* map: term -> z -> *(z + t) *) + type t = T.t ZMap.t TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings let add = TMap.add @@ -597,42 +596,28 @@ module LookupMap = struct let find = TMap.find let zmap_bindings = ZMap.bindings - - (** Returns the bindings of a map, but it transforms the mapped value (which is a set) to a single value (an element in the set). - It returns a list of (offset, term) *) - let zmap_bindings_one_successor zmap = List.map (Tuple2.map2 TSet.any) (zmap_bindings zmap) let zmap_find_opt = ZMap.find_opt - let set_any = TSet.any - - (** Merges the set "m" with the set that is already present in the data structure. *) - let zmap_add x y m = match zmap_find_opt x m with - | None -> ZMap.add x y m - | Some set -> ZMap.add x (TSet.union y set) m + let zmap_add = ZMap.add - (** Returns the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt_set (v,r) map = match find_opt v map with + (** Returns the element to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) + let map_find_opt (v,r) (map:t) = match find_opt v map with | None -> None - | Some zmap -> zmap_find_opt r zmap - - (** Returns one element of the set to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt (v,r) map = Option.map TSet.any (map_find_opt_set (v,r) map) + | Some zmap -> (match zmap_find_opt r zmap with + | None -> None + | Some v -> Some v + ) - (** Adds the term "v'" to the set that is already present in the data structure. *) - let map_add (v,r) v' map = - let zmap = match find_opt v map with - | None -> ZMap.empty - | Some zmap -> zmap - in add v (zmap_add r (TSet.singleton v') zmap) map + let map_add (v,r) v' (map:t) = match find_opt v map with + | None -> add v (zmap_add r v' ZMap.empty) map + | Some zmap -> add v (zmap_add r v' zmap) map - let show_map map = + let show_map (map:t) = List.fold_left (fun s (v, zmap) -> s ^ T.show v ^ "\t:\n" ^ List.fold_left (fun s (r, v) -> - s ^ "\t" ^ Z.to_string r ^ ": " ^ List.fold_left - (fun s k -> s ^ T.show k ^ ";") - "" (TSet.elements v) ^ ";; ") + s ^ "\t" ^ Z.to_string r ^ ": " ^ T.show v ^ "; ") "" (zmap_bindings zmap) ^ "\n") "" (bindings map) @@ -647,23 +632,21 @@ module LookupMap = struct remove v' (add v zmap map) (** Find all outgoing edges of v in the automata.*) - let successors v map = + let successors v (map:t) = match find_opt v map with | None -> [] - | Some zmap -> zmap_bindings_one_successor zmap + | Some zmap -> zmap_bindings zmap (** Filters elements from the mapped values which fulfil the predicate p. *) - let filter_if map p = + let filter_if (map:t) p = TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ t_set -> let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) zmap + let zmap = ZMap.filter (fun key value -> p value) zmap in if ZMap.is_empty zmap then None else Some zmap) map (** Maps elements from the mapped values by applying the function f to them. *) - let map_values map f = + let map_values (map:t) f = TMap.map (fun zmap -> - ZMap.map (fun t_set -> TSet.map f t_set) zmap) map + ZMap.map f zmap) map end (** Quantitative congruence closure on terms *) @@ -698,17 +681,22 @@ module CongruenceClosure = struct (** adds a mapping v -> r -> size -> { v' } to the map, or if there are already elements in v -> r -> {..} then v' is added to the previous set *) - let map_set_add = LMap.map_add + let map_set_add (v,r) v' (map:t) = match TMap.find_opt v map with + | None -> TMap.add v (ZMap.add r (TSet.singleton v') ZMap.empty) map + | Some imap -> TMap.add v ( + match ZMap.find_opt r imap with + | None -> ZMap.add r (TSet.singleton v') imap + | Some set -> ZMap.add r (TSet.add v' set) imap) map + let shift = LMap.shift - let map_set_mem (v,r) v' map = match TMap.find_opt v map with + let map_set_mem (v,r) v' (map:t) = match TMap.find_opt v map with | None -> false | Some imap -> (match ZMap.find_opt r imap with | None -> false | Some set -> TSet.mem v' set ) - (** Map of partition, transform union find to a map of type V -> Z -> V set with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) @@ -850,6 +838,13 @@ module CongruenceClosure = struct s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " ^ T.show v ^ "\n") "" clist + let filter_if map p = + TMap.filter_map (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ t_set -> let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) zmap + in if ZMap.is_empty zmap then None else Some zmap) map + let filter_map f (diseq:t) = TMap.filter_map (fun _ zmap -> @@ -1060,7 +1055,7 @@ module CongruenceClosure = struct let get_transitions (uf, map) = List.concat_map (fun (t, zmap) -> (List.map (fun (edge_z, res_t) -> - (edge_z, t, TUF.find_no_pc uf (LMap.set_any res_t))) @@ + (edge_z, t, TUF.find_no_pc uf res_t)) @@ (LMap.zmap_bindings zmap))) (LMap.bindings map) @@ -1195,7 +1190,7 @@ module CongruenceClosure = struct let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> let rest = match LMap.zmap_find_opt r' zmap with | None -> rest - | Some v'' -> (LMap.set_any v', LMap.set_any v'',Z.zero)::rest + | Some v'' -> (v', v'', Z.zero)::rest in LMap.zmap_add r' v' zmap, rest) (imap1,rest) infl2 in LMap.remove v2 (LMap.add v zmap map), rest @@ -1206,7 +1201,7 @@ module CongruenceClosure = struct let rest = match LMap.zmap_find_opt r' zmap with | None -> rest - | Some v'' -> (LMap.set_any v',LMap.set_any v'',Z.zero)::rest + | Some v'' -> (v', v'',Z.zero)::rest in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in LMap.remove v1 (LMap.add v zmap map), rest in @@ -1532,7 +1527,7 @@ module CongruenceClosure = struct let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms predicate new_parents_map uf = (* modify mapped values -> change terms to their new representatives or remove them, if the representative class was completely removed. *) - let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (LMap.filter_if diseq (not % predicate)) in + let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (Disequalities.filter_if diseq (not % predicate)) in (* modify left hand side of map *) let res, uf = remove_terms_from_map (uf, diseq) removed_terms new_parents_map in if M.tracing then M.trace "wrpointer-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (Disequalities.show_neq res) (TUF.show_uf uf); res, uf From 06f31d83d4d7710024330cd1ab51739d61ad7de4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 19 Jun 2024 15:35:41 +0200 Subject: [PATCH 157/323] new method of restricting the automaton --- src/cdomains/congruenceClosure.ml | 273 ++++++------------ src/cdomains/weaklyRelationalPointerDomain.ml | 10 +- 2 files changed, 100 insertions(+), 183 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 47ef271234..d39cfc693f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1216,6 +1216,13 @@ module CongruenceClosure = struct closure (uf, map, min_repr) queue rest ) + let closure_no_min_repr cc conjs = + match cc with + | None -> None + | Some cc -> + let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq} [] + (** Parameters: cc conjunctions. @@ -1363,174 +1370,89 @@ module CongruenceClosure = struct (* Remove variables: *) - let add_to_map_of_children value map term = - if T.equal term value then map else - match TMap.find_opt term map with - | None -> TMap.add term [value] map - | Some list -> TMap.add term (value::list) map - - let remove_from_map_of_children parent child map = - match List.remove_if (T.equal child) (TMap.find parent map) with - | [] -> TMap.remove parent map - | new_children -> TMap.add parent new_children map - - (* Returns true if any (strict) subterm of t1 is already present in - the same equivalence class as t2. *) - let rec detect_cyclic_dependencies t1 t2 cc = - match t1 with - | Addr v -> false - | Deref (t1, _, _) -> - let v1, o1 = TUF.find_no_pc cc.uf t1 in - let v2, o2 = TUF.find_no_pc cc.uf t2 in - if T.equal v1 v2 then true else - detect_cyclic_dependencies t1 t2 cc - - let add_successor_terms cc t = - let add_one_successor (cc, successors) (edge_z, _) = - let _, uf_offset, uf = TUF.find cc.uf t in - let cc = {cc with uf = uf} in - match SSet.deref_term t Z.(edge_z - uf_offset) cc.set with - | exception (T.UnsupportedCilExpression _) -> - (cc, successors) - | successor -> - let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in - let _, cc, _ = if subterm_already_present then (t, Z.zero), cc, [] - else (if M.tracing then M.trace "wrpointer" "insert successor: %s. Map: %s\n" (T.show successor) (LMap.show_map cc.map); Tuple3.map2 Option.get (insert_no_min_repr cc successor)) in - (cc, if subterm_already_present then successors else successor::successors) in - List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) - - (** Parameters: - - `cc`: congruence closure data structure - - `predicate`: predicate that returns true for terms which need to be removed from the data structure. - It takes `uf` as a parameter. - - Returns: - - `new_set`: subset of `set` which contains the terms that do not have to be removed. - - `removed_terms`: list of all elements of `set` which contains the terms that have to be removed. - - `map_of_children`: maps each element of union find to its children in the union find tree. It is used in order to later remove these elements from the union find data structure. - - `cc`: updated congruence closure data structure. - *) - let remove_terms_from_set cc predicate = - let rec remove_terms_recursive (new_set, removed_terms, map_of_children, cc) = function - | [] -> (new_set, removed_terms, map_of_children, cc) - | el::rest -> - let new_set, removed_terms = if predicate cc.uf el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in - let uf_parent = TUF.parent cc.uf el in - let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in - (* in order to not lose information by removing some elements, we add dereferences values to the union find.*) - let cc, successors = add_successor_terms cc el in - remove_terms_recursive (new_set, removed_terms, map_of_children, cc) (rest @ successors) + let remove_terms_from_eq predicate cc = + let rec insert_terms cc = + function | [] -> cc | t::ts -> insert_terms (Option.bind cc (fun cc -> Tuple3.second (insert_no_min_repr cc t))) ts in + (* start from all initial states that are still valid and find new representatives if necessary *) + (* new_reps maps each representative term to the new representative of the equivalence class *) + (*but new_reps contains an element but not necessarily the representative!!*) + let find_new_repr state old_rep old_z new_reps = + match LMap.find_opt old_rep new_reps with + | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps + | None -> if not @@ predicate old_rep then + old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) + (* the representative need to be removed from the data structure: state is the new repr.*) + state, Z.zero, TMap.add old_rep (state, old_z) new_reps in + let add_atom (new_reps, new_cc, reachable_old_reps) state = + let old_rep, old_z = TUF.find_no_pc cc.uf state in + let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in + let new_cc = insert_terms new_cc [state; new_rep] in + let new_cc = closure_no_min_repr new_cc [(state, new_rep, new_z)] in + (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) in - remove_terms_recursive (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) - - let show_map_of_children map_of_children = - List.fold_left - (fun s (v, list) -> - s ^ T.show v ^ "\t:\n" ^ - List.fold_left - (fun s v -> - s ^ T.show v ^ "; ") - "\t" list ^ "\n") - "" (TMap.bindings map_of_children) - - (** Removes all terms in "removed_terms" from the union find data structure. - - Returns: - - `uf`: the updated union find tree - - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. - *) - let remove_terms_from_uf uf removed_terms map_of_children predicate = - let find_not_removed_element set = match List.find (fun el -> not (predicate uf el)) set with - | exception Not_found -> List.first set - | t -> t - in - let remove_term (uf, new_parents_map, map_of_children) t = - match LMap.find_opt t map_of_children with - | None -> - (* t has no children, so we can safely delete the element from the data structure *) - (* we just need to update the size on the whole path from here to the root *) - let new_parents_map = if TUF.is_root uf t then new_parents_map else LMap.add t (TUF.parent uf t) new_parents_map in - let parent = fst (TUF.parent uf t) in - let map_of_children = if TUF.is_root uf t then map_of_children else remove_from_map_of_children parent t map_of_children in - (TUF.ValMap.remove t (TUF.modify_size t uf pred), new_parents_map, map_of_children) - | Some children -> - let map_of_children = LMap.remove t map_of_children in - if TUF.is_root uf t then - (* t is a root and it has some children: - 1. choose new root. - The new_root is in any case one of the children of the old root. - If possible, we choose one of the children that is not going to be deleted. *) - let new_root = find_not_removed_element children in - let remaining_children = List.remove_if (T.equal new_root) children in - let offset_new_root = TUF.parent_offset uf new_root in - (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) - let new_size, map_of_children, uf = List.fold - (fun (total_size, map_of_children, uf) child -> - (* update parent and offset *) - let uf = TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf child - offset_new_root)) in - total_size + TUF.subtree_size uf child, add_to_map_of_children child map_of_children new_root, uf - ) (0, map_of_children, uf) remaining_children in - (* Update new root -> set itself as new parent. *) - let uf = TUF.modify_parent uf new_root (new_root, Z.zero) in - (* update size of equivalence class *) - let uf = TUF.modify_size new_root uf ((+) new_size) in - (TUF.ValMap.remove t uf, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) + let new_reps, new_cc, reachable_old_reps = + List.fold add_atom (TMap.empty, (Some(init_cc [])),[]) (List.filter (not % predicate) @@ SSet.get_atoms cc.set) in + let cmap = Disequalities.comp_map cc.uf in + (* breadth-first search of reachable states *) + let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = + let old_rep_s, old_z_s = TUF.find_no_pc cc.uf s_t in + let find_successor z t = + match SSet.deref_term t Z.(s_z-z) cc.set with + | exception (T.UnsupportedCilExpression _) -> None + | successor -> if (not @@ predicate successor) then Some successor else None in + let find_successor_in_set (z, term_set) = + TSet.choose_opt @@ TSet.filter_map (find_successor z) term_set in + (* find successor term -> find any element in equivalence class that can be dereferenced *) + match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with + | Some successor_term -> if (not @@ predicate successor_term) then + let new_cc = insert_terms new_cc [successor_term] in + match LMap.find_opt old_rep_s new_reps with + | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) + new_reps, closure_no_min_repr new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps + | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. + -> we choose a successor term *(t+z) for any + -> we need add the successor state to the list of states that still need to be visited + *) + TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps else - (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) - let (new_root, new_offset) = TUF.parent uf t in - let remaining_children = List.remove_if (T.equal new_root) children in - (* update all parents of the children of t *) - let map_of_children, uf = List.fold - (fun (map_of_children, uf) child -> - (* update parent and offset *) - add_to_map_of_children child map_of_children new_root, - TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf t + new_offset)) - ) (map_of_children, uf) remaining_children in - (* update size of equivalence class *) - let uf = TUF.modify_size new_root uf pred in - (TUF.ValMap.remove t uf, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) + (new_reps, new_cc, reachable_old_reps) + | None -> + (* the term cannot be dereferenced, so we won't add this transition. *) + (new_reps, new_cc, reachable_old_reps) in - List.fold_left remove_term (uf, LMap.empty, map_of_children) removed_terms - - let show_new_parents_map new_parents_map = List.fold_left - (fun s (v1, (v2, o2)) -> - s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") - "" (TMap.bindings new_parents_map) + (* find all successors that are still reachable *) + let rec add_transitions new_reps new_cc = function + | [] -> new_reps, new_cc + | (old_rep, new_rep, z)::rest -> + let successors = LMap.successors old_rep cc.map in + let new_reps, new_cc, reachable_old_reps = + List.fold (add_transition (old_rep, new_rep,z)) (new_reps, new_cc, []) successors in + add_transitions new_reps new_cc (rest@reachable_old_reps) + in add_transitions new_reps new_cc + (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) - let rec find_new_root new_parents_map uf v = - match LMap.find_opt v new_parents_map with - | None -> TUF.find_opt uf v - | Some (new_parent, new_offset) -> - match find_new_root new_parents_map uf new_parent with - | None -> None - | Some (r, o, uf) -> Some (r, Z.(o + new_offset), uf) - - (** Removes all terms from the mapped values of this map, - for which "predicate" is false. *) - let remove_terms_from_mapped_values map predicate = - LMap.filter_if map (not % predicate) - - (** For all the elements in the removed terms set, it moves the mapped value to the new root. - Returns new map and new union-find. *) - let remove_terms_from_map (uf, map) removed_terms new_parents_map = - let remove_from_map (map, uf) term = - match LMap.find_opt term map with - | None -> map, uf - | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) - match find_new_root new_parents_map uf term with - | None -> LMap.remove term map, uf - | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term map, uf - in List.fold_left remove_from_map (map, uf) removed_terms - - let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms predicate new_parents_map uf = - (* modify mapped values - -> change terms to their new representatives or remove them, if the representative class was completely removed. *) - let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (Disequalities.filter_if diseq (not % predicate)) in - (* modify left hand side of map *) - let res, uf = remove_terms_from_map (uf, diseq) removed_terms new_parents_map in - if M.tracing then M.trace "wrpointer-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (Disequalities.show_neq res) (TUF.show_uf uf); res, uf + let rec find_new_root new_reps uf v = + match TMap.find_opt v new_reps with + | None -> None + | Some (new_t, z1) -> + let t_rep, z2 = TUF.find_no_pc uf new_t in + Some (t_rep, Z.(z2-z1)) + + let remove_terms_from_diseq diseq new_reps cc = + let disequalities = Disequalities.get_disequalities diseq + in + let add_disequality new_diseq = function + | Nequal(t1,t2,z) -> + begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with + | Some (t1',z1'), Some (t2', z2') -> (t1', t2', Z.(z2'+z-z1'))::new_diseq + | _ -> new_diseq + end + | _-> new_diseq + in + let new_diseq = List.fold add_disequality [] disequalities + in congruence_neq cc new_diseq (** Remove terms from the data structure. It removes all terms for which "predicate" is false, @@ -1538,22 +1460,17 @@ module CongruenceClosure = struct let remove_terms predicate cc = let old_cc = cc in (* first find all terms that need to be removed *) - let set, removed_terms, map_of_children, cc = - remove_terms_from_set cc predicate - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all old_cc); - let uf, new_parents_map, _ = - remove_terms_from_uf cc.uf removed_terms map_of_children predicate - in let map = - remove_terms_from_mapped_values cc.map (predicate cc.uf) - in let map, uf = - remove_terms_from_map (uf, map) removed_terms new_parents_map - in let diseq, uf = - remove_terms_from_diseq cc.diseq removed_terms (predicate cc.uf) new_parents_map uf - in let min_repr, uf = MRMap.compute_minimal_representatives (uf, set, map) - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all old_cc) (show_all {uf; set; map; min_repr; diseq}); - {uf; set; map; min_repr; diseq} + match remove_terms_from_eq (predicate cc.uf) cc with + | new_reps, Some cc -> + begin match remove_terms_from_diseq old_cc.diseq new_reps cc with + | Some cc -> + let min_repr, uf = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" + (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq}); + Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq} + | None -> None + end + | _,None -> None (* join *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 0b5b2234af..43c3f7d9c9 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -158,14 +158,14 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - Option.map (remove_terms (fun _ -> T.is_subterm (Addr var))) cc + Option.bind cc (remove_terms (fun _ -> T.is_subterm (Addr var))) (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.map (remove_terms (fun _ -> T.contains_variable vars)) cc + Option.bind cc (remove_terms (fun _ -> T.contains_variable vars)) (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", @@ -173,19 +173,19 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.map (remove_terms (fun _ t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) cc + Option.bind cc (remove_terms (fun _ t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in - Option.map (remove_terms (fun uf -> MayBeEqual.may_be_equal ask uf s term)) cc + Option.bind cc (remove_terms (fun uf -> MayBeEqual.may_be_equal ask uf s term)) (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.map (remove_terms (fun uf -> MayBeEqual.may_point_to_one_of_these_adresses ask address)) cc + Option.bind cc (remove_terms (fun uf -> MayBeEqual.may_point_to_one_of_these_adresses ask address)) end From 8dbbe48f9aeedab686dad619bd9376ac3f13a0b4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 20 Jun 2024 11:49:24 +0200 Subject: [PATCH 158/323] ignore floats and catch an exception --- src/cdomains/congruenceClosure.ml | 31 ++++++++++++------- src/cdomains/weaklyRelationalPointerDomain.ml | 14 +++++---- 2 files changed, 27 insertions(+), 18 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 007f3404c4..561baf8c36 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -187,9 +187,10 @@ module T = struct let default_int_type = ILong (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) let to_cil_constant z t = - let typ_size = get_element_size_in_bits t in - let z = if Z.equal z Z.zero || Z.equal typ_size Z.zero then Z.zero else - Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) + let z = if Z.equal z Z.zero then Z.zero else + let typ_size = get_element_size_in_bits t in + if Z.equal typ_size Z.zero then Z.zero else + Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) let to_cil_sum off cil_t = if Z.(equal zero off) then cil_t else @@ -217,11 +218,15 @@ module T = struct else raise (UnsupportedCilExpression "Field on a non-compound") with | Cilfacade.TypeOfError _ -> raise (UnsupportedCilExpression "typeOf error") + let is_float = function + | TFloat _ -> true + | _ -> false + let check_valid_pointer term = match typeOf term with (* we want to make sure that the expression is valid *) | exception GoblintCil__Errormsg.Error -> raise (UnsupportedCilExpression "this expression is not coherent") | typ -> (* we only track equalties between pointers (variable of size 64)*) - if get_size_in_bits typ <> bitsSizeOfPtr () then raise (UnsupportedCilExpression "not a pointer variable") + if get_size_in_bits typ <> bitsSizeOfPtr () || is_float typ then raise (UnsupportedCilExpression "not a pointer variable") else term let dereference_exp exp offset = @@ -330,14 +335,16 @@ module T = struct end | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e - let of_cil_neg ask neg e = let res = match of_cil_neg ask neg (Cil.constFold false e) with - | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; - None, None - | t, z -> t, Some z - in (if M.tracing && not neg then match res with - | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) - | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); - | _ -> ()); res + let of_cil_neg ask neg e = + if is_float (typeOf e) then None, None else + let res = match of_cil_neg ask neg (Cil.constFold false e) with + | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; + None, None + | t, z -> t, Some z + in (if M.tracing && not neg then match res with + | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) + | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); + | _ -> ()); res (** Convert the expression to a term, and additionally check that the term is 64 bits *) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 0b5b2234af..7cb183f1dc 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -22,12 +22,14 @@ module MayBeEqual = struct (**Find out if two addresses are possibly equal by using the MayPointTo query. *) let may_point_to_address (ask:Queries.ask) adresses t2 off = - let exp2 = T.to_cil_sum off (T.to_cil t2) in - let mpt1 = adresses in - let mpt2 = ask.f (MayPointTo exp2) in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" - AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res + match T.to_cil_sum off (T.to_cil t2) with + | exception (T.UnsupportedCilExpression _) -> true + | exp2 -> + let mpt1 = adresses in + let mpt2 = ask.f (MayPointTo exp2) in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res let may_point_to_same_address (ask:Queries.ask) t1 t2 off = if T.equal t1 t2 then true else From afaf4097670547931cbc1a2584fe963f9a13b9ff Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 21 Jun 2024 16:53:41 +0200 Subject: [PATCH 159/323] fix bugs with offsets --- src/cdomains/congruenceClosure.ml | 44 +++++++++++++++++++++++-------- 1 file changed, 33 insertions(+), 11 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 561baf8c36..54212b5481 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -702,6 +702,16 @@ module CongruenceClosure = struct (ZMap.bindings smap) ) % TMap.bindings + let bindings_args = + List.flatten % + List.concat_map + (fun (t, smap) -> + List.map (fun (z, arglist) -> + List.map (fun (a,b) -> + (t,z,a,b)) arglist) + (ZMap.bindings smap) + ) % TMap.bindings + (** adds a mapping v -> r -> size -> { v' } to the map, or if there are already elements in v -> r -> {..} then v' is added to the previous set *) @@ -824,21 +834,20 @@ module CongruenceClosure = struct | Some imap1, Some imap2 -> let ilist1 = ZMap.bindings imap1 in let rest = List.fold_left (fun rest (r1,_) -> - match ZMap.find_opt Z.(r1-r) imap2 with + match ZMap.find_opt Z.(r1+r) imap2 with | None -> rest | Some _ -> let l1 = match map_find_opt (v1,r1) arg with None -> [] | Some list -> list in - let l2 = match map_find_opt (v2,Z.(r1-r)) arg + let l2 = match map_find_opt (v2,Z.(r1+r)) arg with None -> [] | Some list -> list in - fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if T.equal v1 v2 then if Z.equal r'1 r'2 then raise Unsat + fold_left2 (fun rest (v1',r'1) (v2',r'2) -> + if T.equal v1' v2' then if Z.equal r'1 r'2 then raise Unsat else rest - (* disequalities propagate only if the terms have same size*) - else if Z.equal (T.get_size v1) (T.get_size v2) then - (v1,v2,Z.(r'2-r'1))::rest else rest ) rest l1 l2) + else + (v1',v2',Z.(r'2-r'1))::rest ) rest l1 l2) rest ilist1 in propagate_neq (uf,cmap,arg,neq) rest (* @@ -854,8 +863,20 @@ module CongruenceClosure = struct let show_neq neq = let clist = bindings neq in List.fold_left (fun s (v,r,v') -> - s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " - ^ T.show v ^ "\n") "" clist + s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " + ^ T.show v' ^ "\n") "" clist + + let show_cmap neq = + let clist = bindings neq in + List.fold_left (fun s (v,r,v') -> + s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " = " + ^ T.show v' ^ "\n") "" clist + + let show_arg arg = + let clist = bindings_args arg in + List.fold_left (fun s (v,z,v',r) -> + s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " --> " + ^ T.show v^ "+"^ Z.to_string z ^ "\n") "" clist let filter_map f (diseq:t) = TMap.filter_map @@ -946,7 +967,8 @@ module CongruenceClosure = struct end (** Minimal representatives map. - It maps each representative term of an equivalence class to the minimal term of this representative class. *) + It maps each representative term of an equivalence class to the minimal term of this representative class. + rep -> (t, z) means that t = rep + z *) module MRMap = struct type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] @@ -1099,7 +1121,7 @@ module CongruenceClosure = struct let normalize_disequality (t1, t2, z) = let (min_state1, min_z1) = MRMap.find t1 cc.min_repr in let (min_state2, min_z2) = MRMap.find t2 cc.min_repr in - let new_offset = Z.(min_z2 - min_z1 + z) in + let new_offset = Z.(-min_z2 + min_z1 + z) in if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) else Nequal (min_state2, min_state1, Z.(-new_offset)) in From 104360cec847eeb87032a8fc219415c0682def61 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 24 Jun 2024 16:56:27 +0200 Subject: [PATCH 160/323] add conf file for base analysis with which we can compare wrpointer --- conf/svcomp-no-var-eq.json | 145 +++++++++++++++++++++++++++++++++++++ 1 file changed, 145 insertions(+) create mode 100644 conf/svcomp-no-var-eq.json diff --git a/conf/svcomp-no-var-eq.json b/conf/svcomp-no-var-eq.json new file mode 100644 index 0000000000..a903d29e76 --- /dev/null +++ b/conf/svcomp-no-var-eq.json @@ -0,0 +1,145 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "symb_locks", + "region", + "thread", + "threadJoins" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": true, + "id": "enumerate", + "unknown": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "invariant_set" + ], + "invariant-types": [ + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": false, + "other": false, + "accessed": false, + "exact": true, + "exclude-vars": [ + "tmp\\(___[0-9]+\\)?", + "cond", + "RETURN", + "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", + ".*____CPAchecker_TMP_[0-9]+", + "__VERIFIER_assert__cond", + "__ksymtab_.*", + "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" + ] + } + }, + "pre": { + "enabled": false + } + } From 50f9671a988103fe3f476cab38aef6c4d6091987 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 24 Jun 2024 21:16:37 +0200 Subject: [PATCH 161/323] add tracing for get_normal_form --- src/cdomains/congruenceClosure.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 54212b5481..d5927d7605 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1125,6 +1125,7 @@ module CongruenceClosure = struct if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) else Nequal (min_state2, min_state1, Z.(-new_offset)) in + if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)) disequalities in BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities) From e758b5e775183f2d90db0fc735fc1c78fb17c126 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 24 Jun 2024 21:58:44 +0200 Subject: [PATCH 162/323] made sure to always just add pointers to the data structure --- .../weaklyRelationalPointerAnalysis.ml | 47 ++++++++++--------- src/cdomains/congruenceClosure.ml | 26 ++++++---- 2 files changed, 41 insertions(+), 32 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 30bdf4faec..9e4e7ef359 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -49,24 +49,26 @@ struct | _ -> Result.top q let assign_lval t ask lval expr = - match T.get_element_size_in_bits (typeOfLval lval), T.of_lval ask lval, T.of_cil ask expr with - (* Indefinite assignment *) - | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t - (* Definite assignment *) - | s, lterm, (Some term, Some offset) -> - let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in - if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); - t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> - D.remove_may_equal_terms ask s lterm |> - meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo (typeOfLval lval) - (* invertibe assignment *) - | exception (T.UnsupportedCilExpression _) -> D.top () - (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. - We have to forget all the information we had. - This should almost never happen. - Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) - | _ -> D.top () + (* ignore assignments to values that are not 64 bits *) (*TODO what if there is a cast*) + if T.check_valid_pointer expr then + match T.get_element_size_in_bits (typeOfLval lval), T.of_lval ask lval, T.of_cil ask expr with + (* Indefinite assignment *) + | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t + (* Definite assignment *) + | s, lterm, (Some term, Some offset) -> + let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in + if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); + t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> + D.remove_may_equal_terms ask s lterm |> + meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> + D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo (typeOfLval lval) + | exception (T.UnsupportedCilExpression _) -> D.top () + (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. + We have to forget all the information we had. + This should almost never happen. + Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) + | _ -> D.top () + else t let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in @@ -74,10 +76,11 @@ struct let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in - let res = meet_conjs_opt props ctx.local in + let valid_props = T.filter_valid_pointers props in + let res = meet_conjs_opt valid_props ctx.local in if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; prop_list: %s\n" - d_exp e pos (show_conj props); + if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" + d_exp e pos (show_conj valid_props); res let body ctx f = ctx.local (*DONE*) @@ -113,7 +116,7 @@ struct local variables of the caller and the pointers that were modified by the function. *) let enter ctx var_opt f args = (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in + let added_equalities = T.filter_valid_pointers (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 608111fd4f..abde4965a9 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -224,10 +224,13 @@ module T = struct let check_valid_pointer term = match typeOf term with (* we want to make sure that the expression is valid *) - | exception GoblintCil__Errormsg.Error -> raise (UnsupportedCilExpression "this expression is not coherent") + | exception GoblintCil__Errormsg.Error -> false | typ -> (* we only track equalties between pointers (variable of size 64)*) - if get_size_in_bits typ <> bitsSizeOfPtr () || is_float typ then raise (UnsupportedCilExpression "not a pointer variable") - else term + if get_size_in_bits typ <> bitsSizeOfPtr () || is_float typ then false + else true + + let filter_valid_pointers = + List.filter (function | Equal(t1,t2,z)| Nequal(t1,t2,z) -> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) let dereference_exp exp offset = let find_field cinfo = try @@ -249,7 +252,7 @@ module T = struct end | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) - in check_valid_pointer res + in if check_valid_pointer res then res else raise (UnsupportedCilExpression "not a pointer variable") let get_size = get_size_in_bits % type_of_term @@ -347,17 +350,20 @@ module T = struct | _ -> ()); res (** Convert the expression to a term, - and additionally check that the term is 64 bits *) + and additionally check that the term is 64 bits. + If it's not a 64bit pointer, it returns None, None. *) let of_cil ask e = match of_cil_neg ask false e with | Some t, Some z -> (* check if t is a valid pointer *) - begin match check_valid_pointer (to_cil t) with - | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a\n%s --> %s + %s\n" d_plainexp e s (show t) (Z.to_string z); - None, None - | _ -> Some t, Some z end + let exp = to_cil t in + if check_valid_pointer exp then + Some t, Some z + else (if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); + None, None) | t, z -> t, z + let map_z_opt op z = Tuple2.map2 (Option.map (op z)) (** Converts a cil expression e = "t1 + off1 - (t2 + off2)" to two terms (Some t1, Some off1), (Some t2, Some off2)*) @@ -1198,7 +1204,7 @@ module CongruenceClosure = struct let v2, r2, uf = TUF.find uf t2 in let sizet1, sizet2 = T.get_size t1, T.get_size t2 in if not (Z.equal sizet1 sizet2) then - (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same"; + (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); closure (uf, map, min_repr) queue rest) else if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) From 9e8c10b2c3063351187dad449605af5560dd6279 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 11:20:43 +0200 Subject: [PATCH 163/323] fixed bug in find of union-find --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index abde4965a9..6ac110da10 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -515,7 +515,7 @@ module UnionFind = struct let (v',r') = parent uf v in if is_root uf v' then (* perform path compresion *) - let (_,uf) = List.fold_left (fun (r0, uf) v -> + let (r',uf) = List.fold_left (fun (r0, uf) v -> let (parent_v, r''), size_v = ValMap.find v uf in let uf = modify_parent uf v (v',Z.(r0+r'')) in let uf = modify_size parent_v uf (fun s -> s - size_v) in From 12f64f2fa3add563ce3d364b2f8d493f64879901 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 11:22:20 +0200 Subject: [PATCH 164/323] properly update offset of long integers --- src/cdomains/congruenceClosure.ml | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6ac110da10..aa90d906c9 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -110,17 +110,21 @@ module T = struct | i -> Some i | exception (UnsupportedCilExpression _) -> None + (*returns Some type for a pointer to a type + and None if the result is not a pointer*) let rec type_of_element typ = match typ with | TArray (typ, _, _) -> type_of_element typ - | TPtr (typ, _) -> typ - | _ -> typ + | TPtr (typ, _) -> Some typ + | _ -> None (** Returns the size of the type. If typ is a pointer, it returns the size of the elements it points to. If typ is an array, it returns the size of the elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int\[]\[]\[] = sizeof(int)). *) let rec get_element_size_in_bits typ = - get_size_in_bits (type_of_element typ) + match type_of_element typ with + | Some typ -> get_size_in_bits typ + | None -> Z.of_int 1 let is_array_type = function | TArray _ -> true @@ -188,7 +192,10 @@ module T = struct (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) let to_cil_constant z t = let z = if Z.equal z Z.zero then Z.zero else - let typ_size = get_element_size_in_bits t in + let typ_size = match t with + | Some t -> get_element_size_in_bits t + | None -> Z.of_int 1 + in if Z.equal typ_size Z.zero then Z.zero else Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) @@ -244,7 +251,7 @@ module T = struct | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) | TArray (typ, _, _) when not (can_be_dereferenced typ) -> - let index = Index (to_cil_constant offset typ, NoOffset) in + let index = Index (to_cil_constant offset (Some typ), NoOffset) in begin match exp with | Lval (Var v, NoOffset) -> Lval (Var v, index) | Lval (Mem v, NoOffset) -> Lval (Mem v, index) @@ -963,7 +970,7 @@ module CongruenceClosure = struct | result -> result | exception (T.UnsupportedCilExpression _) -> let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr and get_normal_form*) - Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z random_type, random_type)), NoOffset)) + Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z (Some random_type), random_type)), NoOffset)) end From d72d622a2ad3179309fa3e966b3b2db4356cf5a7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 11:36:14 +0200 Subject: [PATCH 165/323] add regression test for widen --- tests/regression/82-wrpointer/29-widen.c | 25 ++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 tests/regression/82-wrpointer/29-widen.c diff --git a/tests/regression/82-wrpointer/29-widen.c b/tests/regression/82-wrpointer/29-widen.c new file mode 100644 index 0000000000..d91e9fbacc --- /dev/null +++ b/tests/regression/82-wrpointer/29-widen.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +int a; +long b, c, d, e, f, g, h; +int *i; +k() { + int j; + long top; + while (top) { + b = a * 424; + c = j; + d = j + b; + e = a * 424; + f = e + 8; + g = j; + h = j + f; + i = h; + a = a + 1; + __goblint_check(g == c); + // __goblint_check(h == 8 + d); + __goblint_check((long)i == h); + __goblint_check(j == c); + } +} +main() { k(); } From 2b4fdd1ec22d4d82102641a1b4271b9f477ff081 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 12:05:32 +0200 Subject: [PATCH 166/323] revert wrong fix --- .../weaklyRelationalPointerAnalysis.ml | 36 +++++++++---------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 9e4e7ef359..6c6405ae44 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -50,25 +50,23 @@ struct let assign_lval t ask lval expr = (* ignore assignments to values that are not 64 bits *) (*TODO what if there is a cast*) - if T.check_valid_pointer expr then - match T.get_element_size_in_bits (typeOfLval lval), T.of_lval ask lval, T.of_cil ask expr with - (* Indefinite assignment *) - | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t - (* Definite assignment *) - | s, lterm, (Some term, Some offset) -> - let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in - if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); - t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> - D.remove_may_equal_terms ask s lterm |> - meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo (typeOfLval lval) - | exception (T.UnsupportedCilExpression _) -> D.top () - (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. - We have to forget all the information we had. - This should almost never happen. - Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) - | _ -> D.top () - else t + match T.get_element_size_in_bits (typeOfLval lval), T.of_lval ask lval, T.of_cil ask expr with + (* Indefinite assignment *) + | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t + (* Definite assignment *) + | s, lterm, (Some term, Some offset) -> + let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in + if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); + t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> + D.remove_may_equal_terms ask s lterm |> + meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> + D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo (typeOfLval lval) + | exception (T.UnsupportedCilExpression _) -> D.top () + (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. + We have to forget all the information we had. + This should almost never happen. + Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) + | _ -> D.top () let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in From 2135fea0d398501b5108aea60259ed8166dc8f45 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 12:05:46 +0200 Subject: [PATCH 167/323] adapt test case --- tests/regression/82-wrpointer/19-disequalities.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/82-wrpointer/19-disequalities.c b/tests/regression/82-wrpointer/19-disequalities.c index bee70deea1..83c2f2fa08 100644 --- a/tests/regression/82-wrpointer/19-disequalities.c +++ b/tests/regression/82-wrpointer/19-disequalities.c @@ -3,8 +3,8 @@ #include void main(void) { - int *i; - int **j; + long *i; + long **j; j = (int **)malloc(sizeof(int *) + 7); *(j + 3) = (int *)malloc(sizeof(int)); int *k; From 944bc953a13bd9a86e2c691f853797e210cc2cf0 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 12:45:41 +0200 Subject: [PATCH 168/323] replace Z.of_int 1 with Z.one --- src/cdomains/congruenceClosure.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index aa90d906c9..e9964fecb4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -124,7 +124,7 @@ module T = struct let rec get_element_size_in_bits typ = match type_of_element typ with | Some typ -> get_size_in_bits typ - | None -> Z.of_int 1 + | None -> Z.one let is_array_type = function | TArray _ -> true @@ -194,7 +194,7 @@ module T = struct let z = if Z.equal z Z.zero then Z.zero else let typ_size = match t with | Some t -> get_element_size_in_bits t - | None -> Z.of_int 1 + | None -> Z.one in if Z.equal typ_size Z.zero then Z.zero else Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) From e2973355568b40440f651d3376e8787ff6942d89 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 12:46:45 +0200 Subject: [PATCH 169/323] remove var-eq analysis from conf file --- conf/svcomp-wrpointer.json | 1 - 1 file changed, 1 deletion(-) diff --git a/conf/svcomp-wrpointer.json b/conf/svcomp-wrpointer.json index f47b7aa5eb..e7cd14068a 100644 --- a/conf/svcomp-wrpointer.json +++ b/conf/svcomp-wrpointer.json @@ -26,7 +26,6 @@ "expRelation", "mhp", "assert", - "var_eq", "symb_locks", "region", "thread", From babee145418805d4ed90f9d31799d67a4bb56974 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 25 Jun 2024 15:19:47 +0200 Subject: [PATCH 170/323] intersect answers of MayPointTo query for equal pointers --- .../weaklyRelationalPointerAnalysis.ml | 19 +++++++++++++++++++ src/cdomains/congruenceClosure.ml | 18 +++++++++++++++++- 2 files changed, 36 insertions(+), 1 deletion(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 6c6405ae44..959587a9ef 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -35,6 +35,24 @@ struct in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res + let query_may_point_to (ask:Queries.ask) t e = + match T.of_cil ask e with + | Some term, Some offset -> + begin match insert t term with + | _,None -> MayBeEqual.AD.top() + | _,Some cc -> + let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + let equal_terms = List.filter valid_term comp in + let intersect_query_result res (term,z) = + let next_query = ask.f (MayPointTo (T.to_cil_sum z (T.to_cil term))) in + MayBeEqual.AD.meet res next_query in + List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms + end + | _ -> + MayBeEqual.AD.top() + let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in match q with @@ -46,6 +64,7 @@ struct end (* TODO Invariant. | Queries.Invariant context -> get_normal_form context*) + | MayPointTo e -> query_may_point_to (ask_of_ctx ctx) ctx.local e | _ -> Result.top q let assign_lval t ask lval expr = diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index e9964fecb4..2b2f5eb5e5 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -138,6 +138,10 @@ module T = struct | TPtr(TComp _,_) -> true | _ -> false + let is_ptr_type = function + | TPtr _ -> true + | _ -> false + let cil_offs_to_idx (ask: Queries.ask) offs typ = (* TODO: Some duplication with convert_offset in base.ml and cil_offs_to_idx in memOutOfBounds.ml, unclear how to immediately get more reuse *) @@ -346,7 +350,9 @@ module T = struct | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e let of_cil_neg ask neg e = - if is_float (typeOf e) then None, None else + match is_float (typeOf e) with + | exception GoblintCil__Errormsg.Error | true -> None, None + | false -> let res = match of_cil_neg ask neg (Cil.constFold false e) with | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; None, None @@ -734,6 +740,16 @@ module CongruenceClosure = struct map_set_add (TUF.find_no_pc uf v) v comp) TMap.empty (TMap.bindings uf) + (* find all elements that are in the same equivalence class as t + except t*) + let comp_t uf t = + let (t',z') = TUF.find_no_pc uf t in + List.fold_left (fun comp (v,((p,z),_)) -> + let (v', z'') = TUF.find_no_pc uf v in + if T.equal v' t' && not (T.equal v t) then (v, Z.(z'-z''))::comp else comp + ) + [] (TMap.bindings uf) + let flatten_map = ZMap.map (fun zmap -> List.fold_left (fun set (_,mapped) -> TSet.union set mapped) TSet.empty (ZMap.bindings zmap)) From 267294cbb4813bb4344e880501df30342d3a4a55 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 28 Jun 2024 12:00:29 +0200 Subject: [PATCH 171/323] implicitly assume that &x != &y --- src/cdomains/congruenceClosure.ml | 36 ++++++++++++++----- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2b2f5eb5e5..5a7338f312 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -30,6 +30,14 @@ module T = struct type t = (Var.t, exp) term [@@deriving eq, ord, hash] type v_prop = (Var.t, exp) prop [@@deriving ord, hash] + let compare t1 t2 = + match t1,t2 with + | Addr v1, Addr v2 -> Var.compare v1 v2 + | Deref (t1,z1,_), Deref (t2,z2,_) -> let c = compare t1 t2 in + if c = 0 then Z.compare z1 z2 else c + | Addr _, Deref _ -> -1 + | Deref _, Addr _ -> 1 + (** Two propositions are equal if they are syntactically equal or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) let equal_v_prop p1 p2 = @@ -46,6 +54,10 @@ module T = struct let props_equal = List.equal equal_v_prop + let is_addr = function + | Addr _ -> true + | _ -> false + exception UnsupportedCilExpression of string let rec get_size_in_bits typ = match typ with @@ -835,7 +847,11 @@ module CongruenceClosure = struct *) let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) - | (v1,v2,r) :: rest -> (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) + | (v1,v2,r) :: rest -> + (* we don't want to explicitly store disequalities of the kind &x != &y *) + if T.is_addr v1 && T.is_addr v2 then + propagate_neq (uf,cmap,arg,neq) rest else + (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) if T.equal v1 v2 then (* should not happen *) if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) rest else (* check whether it is already in neq *) @@ -1397,14 +1413,16 @@ module CongruenceClosure = struct (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - if T.equal v1 v2 then - if Z.(equal r1 (r2 + r)) then false - else true - else match cc with - | None -> true - | Some cc -> Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq + (* we implicitly assume that &x != &y + z *) + if T.is_addr t1 && T.is_addr t2 then true else + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + if T.equal v1 v2 then + if Z.(equal r1 (r2 + r)) then false + else true + else match cc with + | None -> true + | Some cc -> Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index a2345f73ed..c1c0d6d134 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -93,7 +93,7 @@ module D = struct let show_all = function | None -> "⊥\n" - | Some x -> show_all x + | Some x -> show_all x include Printable.SimpleShow(struct type t = domain let show = show end) From 0e647d2b47428e7f97368478420ada3f89a2d474 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 28 Jun 2024 12:00:29 +0200 Subject: [PATCH 172/323] implicitly assume that &x != &y --- src/cdomains/congruenceClosure.ml | 36 ++++++++++++++----- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2b2f5eb5e5..5a7338f312 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -30,6 +30,14 @@ module T = struct type t = (Var.t, exp) term [@@deriving eq, ord, hash] type v_prop = (Var.t, exp) prop [@@deriving ord, hash] + let compare t1 t2 = + match t1,t2 with + | Addr v1, Addr v2 -> Var.compare v1 v2 + | Deref (t1,z1,_), Deref (t2,z2,_) -> let c = compare t1 t2 in + if c = 0 then Z.compare z1 z2 else c + | Addr _, Deref _ -> -1 + | Deref _, Addr _ -> 1 + (** Two propositions are equal if they are syntactically equal or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) let equal_v_prop p1 p2 = @@ -46,6 +54,10 @@ module T = struct let props_equal = List.equal equal_v_prop + let is_addr = function + | Addr _ -> true + | _ -> false + exception UnsupportedCilExpression of string let rec get_size_in_bits typ = match typ with @@ -835,7 +847,11 @@ module CongruenceClosure = struct *) let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) - | (v1,v2,r) :: rest -> (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) + | (v1,v2,r) :: rest -> + (* we don't want to explicitly store disequalities of the kind &x != &y *) + if T.is_addr v1 && T.is_addr v2 then + propagate_neq (uf,cmap,arg,neq) rest else + (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) if T.equal v1 v2 then (* should not happen *) if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) rest else (* check whether it is already in neq *) @@ -1397,14 +1413,16 @@ module CongruenceClosure = struct (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - if T.equal v1 v2 then - if Z.(equal r1 (r2 + r)) then false - else true - else match cc with - | None -> true - | Some cc -> Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq + (* we implicitly assume that &x != &y + z *) + if T.is_addr t1 && T.is_addr t2 then true else + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + if T.equal v1 v2 then + if Z.(equal r1 (r2 + r)) then false + else true + else match cc with + | None -> true + | Some cc -> Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index a2345f73ed..c1c0d6d134 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -93,7 +93,7 @@ module D = struct let show_all = function | None -> "⊥\n" - | Some x -> show_all x + | Some x -> show_all x include Printable.SimpleShow(struct type t = domain let show = show end) From da7cdb4898019c1309f307c3f58f355e6d25b8c5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 28 Jun 2024 12:47:03 +0200 Subject: [PATCH 173/323] started implementing auxiliaries, but it doesn't quite work yet --- src/cdomains/congruenceClosure.ml | 35 ++++++++----- src/cdomains/weaklyRelationalPointerDomain.ml | 52 +++++++------------ 2 files changed, 41 insertions(+), 46 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 5a7338f312..e214a6738e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -7,7 +7,7 @@ module M = Messages exception Unsat -type ('v, 't) term = Addr of 'v | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] +type ('v, 't) term = Addr of 'v | Aux of 'v * 't | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t [@@deriving eq, ord, hash] (** The terms consist of address constants and dereferencing function with sum of an integer. @@ -32,11 +32,13 @@ module T = struct let compare t1 t2 = match t1,t2 with - | Addr v1, Addr v2 -> Var.compare v1 v2 + | Addr v1, Addr v2 + | Aux (v1,_), Aux (v2,_) -> Var.compare v1 v2 | Deref (t1,z1,_), Deref (t2,z2,_) -> let c = compare t1 t2 in if c = 0 then Z.compare z1 z2 else c - | Addr _, Deref _ -> -1 - | Deref _, Addr _ -> 1 + | Addr _, _ + | _, Deref _ -> -1 + | _ -> 1 (** Two propositions are equal if they are syntactically equal or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) @@ -84,6 +86,7 @@ module T = struct let rec show : t -> string = function | Addr v -> "&" ^ Var.show v + | Aux (v,exp) -> Var.show v ^ show_type exp | Deref (Addr v, z, exp) when Z.equal z Z.zero -> Var.show v ^ show_type exp | Deref (t, z, exp) when Z.equal z Z.zero -> "*" ^ show t^ show_type exp | Deref (t, z, exp) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")"^ show_type exp @@ -94,15 +97,18 @@ module T = struct | _ -> false let rec get_var = function - | Addr v -> v + | Addr v | Aux (v,_) -> v | Deref (t, _, _) -> get_var t (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) let rec contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables - let term_of_varinfo vinfo = + let term_of_varinfo vinfo = (*TODO is this still needed?*) Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) + let aux_term_of_varinfo vinfo = + Aux (vinfo, Lval (Var vinfo, NoOffset)) + let eval_int (ask:Queries.ask) exp = match Cilfacade.get_ikind_exp exp with | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") @@ -196,13 +202,13 @@ module T = struct let rec type_of_term = function - | (Addr v) -> TPtr (v.vtype, []) - | (Deref (_, _, exp)) -> typeOf exp + | Addr v -> TPtr (v.vtype, []) + | Aux (_, exp) | Deref (_, _, exp) -> typeOf exp let to_cil = function | (Addr v) -> AddrOf (Var v, NoOffset) - | (Deref (_, _, exp)) -> exp + | Aux (_, exp) | (Deref (_, _, exp)) -> exp let default_int_type = ILong (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) @@ -340,6 +346,7 @@ module T = struct if is_struct_ptr_type typ then match of_offset ask term off typ (Lval lval) with | Addr x -> Addr x + | Aux (v,exp) -> Aux (v,exp) | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) else of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) @@ -973,7 +980,7 @@ module CongruenceClosure = struct (** Adds all subterms of t to the SSet and the LookupMap*) let rec subterms_of_term (set,map) t = match t with - | Addr _ -> (add t set, map) + | Addr _ | Aux _ -> (add t set, map) | Deref (t',z,_) -> let set = add t set in let map = LMap.map_add (t',z) t map in @@ -988,7 +995,7 @@ module CongruenceClosure = struct let get_atoms set = (* `elements set` returns a sorted list of the elements. The atoms are always smaller that other terms, according to our comparison function. Therefore take_while is enough. *) - BatList.take_while (function Addr _ -> true | _ -> false) (elements set) + BatList.take_while (function Addr _ | Aux _ -> true | _ -> false) (elements set) (** We try to find the dereferenced term between the already existing terms, in order to remember the information about the exp. *) let deref_term t z set = @@ -1349,10 +1356,10 @@ module CongruenceClosure = struct (v,z), Some {cc with uf}, [] else match t with - | Addr a -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in + | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), Some {uf; set; map = cc.map; min_repr; diseq = cc.diseq}, [Addr a] + (t, Z.zero), Some {uf; set; map = cc.map; min_repr; diseq = cc.diseq}, [t] | Deref (t', z, exp) -> match insert_no_min_repr cc t' with | (v, r), None, queue -> (v, r), None, [] @@ -1537,7 +1544,7 @@ module CongruenceClosure = struct let remove_terms predicate cc = let old_cc = cc in (* first find all terms that need to be removed *) - match remove_terms_from_eq (predicate cc.uf) cc with + match remove_terms_from_eq predicate cc with | new_reps, Some cc -> begin match remove_terms_from_diseq old_cc.diseq new_reps cc with | Some cc -> diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index c1c0d6d134..de13e95643 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -13,11 +13,11 @@ module MayBeEqual = struct module AD = ValueDomain.AD let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} - let dummy_var var = T.term_of_varinfo (dummy_varinfo var) + let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} - let return_var var = T.term_of_varinfo (return_varinfo var) + let return_var var = T.aux_term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) (**Find out if two addresses are possibly equal by using the MayPointTo query. *) @@ -33,40 +33,28 @@ module MayBeEqual = struct let may_point_to_same_address (ask:Queries.ask) t1 t2 off = if T.equal t1 t2 then true else - (* two local arrays can never point to the same array *) - let are_different_arrays = match t1, t2 with - | Deref (Addr x1, z1,_), Deref (Addr x2, z2,_) -> if T.is_array_type x1.vtype && T.is_array_type x2.vtype && not (Var.equal x1 x2) then true else false - | _ -> false in - if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t2)) (T.get_var t2) then false else - let exp1 = T.to_cil t1 in - let mpt1 = ask.f (MayPointTo exp1) in - may_point_to_address ask mpt1 t2 off + let exp1 = T.to_cil t1 in + let mpt1 = ask.f (MayPointTo exp1) in + may_point_to_address ask mpt1 t2 off (**Returns true iff by assigning to t1, the value of t2 could change. The parameter s is the size in bits of the variable t1 we are assigning to. *) - let rec may_be_equal ask uf s t1 t2 = - let there_is_an_overlap s s' diff = - if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) - in + let rec may_be_equal ask cc s t1 t2 = match t1, t2 with | CC.Deref (t, z,_), CC.Deref (v, z',_) -> - let (q', z1') = TUF.find_no_pc uf v in - let (q, z1) = TUF.find_no_pc uf t in - let s' = T.get_size t2 in - let diff = Z.(-z' - z1 + z1' + z) in - (* If they are in the same equivalence class but with a different offset, then they are not equal *) + (* If we have a disequality, then they are not equal *) ( - (not (T.equal q' q) || there_is_an_overlap s s' diff) + not (neq_query cc (t,v,Z.(z'-z))) (* or if we know that they are not equal according to the query MayPointTo*) && - (may_point_to_same_address ask q q' Z.(z' - z + z1 - z1')) + (may_point_to_same_address ask t v Z.(z' - z)) ) - || (may_be_equal ask uf s t1 v) - | CC.Deref _, _ -> false (*The value of addresses never change when we overwrite the memory*) - | CC.Addr _ , _ -> T.is_subterm t1 t2 + || (may_be_equal ask cc s t1 v) + | CC.Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) + | CC.Addr _ , _ | CC.Aux _, _ -> T.is_subterm t1 t2 - let may_be_equal ask uf s t1 t2 = - let res = (may_be_equal ask uf s t1 t2) in + let may_be_equal ask cc s t1 t2 = + let res = (may_be_equal ask cc s t1 t2) in if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res @@ -75,7 +63,7 @@ module MayBeEqual = struct | CC.Deref (v, z',_) -> (may_point_to_address ask adresses v z') || (may_point_to_one_of_these_adresses ask adresses v) - | CC.Addr _ -> false + | CC.Addr _ | CC.Aux _ -> false end @@ -160,14 +148,14 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - Option.bind cc (remove_terms (fun _ -> T.is_subterm (Addr var))) + Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (fun _ -> T.contains_variable vars)) + Option.bind cc (remove_terms (T.contains_variable vars)) (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", @@ -175,19 +163,19 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (fun _ t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) + Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in - Option.bind cc (remove_terms (fun uf -> MayBeEqual.may_be_equal ask uf s term)) + Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (remove_terms (fun uf -> MayBeEqual.may_point_to_one_of_these_adresses ask address)) + Option.bind cc (remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address)) end From 8d04d601750b449986f7a962fd3268affc068de7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 28 Jun 2024 18:07:58 +0200 Subject: [PATCH 174/323] solved exception, maybe not in the best possible way --- src/analyses/startStateAnalysis.ml | 6 +++- .../weaklyRelationalPointerAnalysis.ml | 33 ++++++++++++------- src/cdomains/congruenceClosure.ml | 3 +- src/cdomains/weaklyRelationalPointerDomain.ml | 11 +++++-- 4 files changed, 36 insertions(+), 17 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 805c1a3878..3816552774 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -26,8 +26,12 @@ struct let return_varinfo = {dummyFunDec.svar with vid=(-2);vname="wrpointer__@return"} let is_wrpointer_ghost_variable x = x.vid < 0 && String.starts_with x.vname "wrpointer__" + let ask_may_point_to (ask: Queries.ask) exp = + match ask.f (MayPointTo exp) with + (* | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top() *) + | res -> res - let get_value (ask: Queries.ask) exp = ask.f (MayPointTo exp) + let get_value (ask: Queries.ask) exp = ask_may_point_to ask exp (** If e is a known variable, then it returns the value for this variable. If e is &x' for a duplicated variable x' of x, then it returns MayPointTo of &x. diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 959587a9ef..0feb6c5f95 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -35,20 +35,31 @@ struct in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res - let query_may_point_to (ask:Queries.ask) t e = - match T.of_cil ask e with + let query_may_point_to ctx t e = + if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" + d_exp e; + match T.of_cil (ask_of_ctx ctx) e with | Some term, Some offset -> begin match insert t term with | _,None -> MayBeEqual.AD.top() | _,Some cc -> - let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in - let intersect_query_result res (term,z) = - let next_query = ask.f (MayPointTo (T.to_cil_sum z (T.to_cil term))) in - MayBeEqual.AD.meet res next_query in - List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms + let res = let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 && not (T.is_addr t) in + let equal_terms = List.filter valid_term comp in + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); + let intersect_query_result res (term,z) = + let next_query = + let ctx = {ctx with local=Some (init_cc [])} in + match ctx.ask (MayPointTo (T.to_cil_sum Z.(z + offset) (T.to_cil term))) with + | exception (T.UnsupportedCilExpression _) -> MayBeEqual.AD.top() + | res -> if MayBeEqual.AD.is_bot res then MayBeEqual.AD.top() else res + in + MayBeEqual.AD.meet res next_query in + List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms + in if M.tracing then M.trace "wrpointer-query" "may-point-to %a : %a. Is bot: %b\n" + d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res end | _ -> MayBeEqual.AD.top() @@ -64,7 +75,7 @@ struct end (* TODO Invariant. | Queries.Invariant context -> get_normal_form context*) - | MayPointTo e -> query_may_point_to (ask_of_ctx ctx) ctx.local e + | MayPointTo e -> query_may_point_to ctx ctx.local e | _ -> Result.top q let assign_lval t ask lval expr = diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 5a7338f312..08f4743154 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -218,8 +218,7 @@ module T = struct let to_cil_sum off cil_t = if Z.(equal zero off) then cil_t else let typ = typeOf cil_t in - let el_typ = type_of_element typ in - BinOp (PlusPI, cil_t, to_cil_constant off el_typ, typ) + BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with | Some i -> i diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index c1c0d6d134..93b8b03f2e 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -11,7 +11,7 @@ module T = CC.T (**Find out if two addresses are not equal by using the MayPointTo query*) module MayBeEqual = struct - module AD = ValueDomain.AD + module AD = Queries.AD let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} let dummy_var var = T.term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) @@ -20,13 +20,18 @@ module MayBeEqual = struct let return_var var = T.term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) + let ask_may_point_to (ask: Queries.ask) exp = + match ask.f (MayPointTo exp) with + | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () + | res -> res + (**Find out if two addresses are possibly equal by using the MayPointTo query. *) let may_point_to_address (ask:Queries.ask) adresses t2 off = match T.to_cil_sum off (T.to_cil t2) with | exception (T.UnsupportedCilExpression _) -> true | exp2 -> let mpt1 = adresses in - let mpt2 = ask.f (MayPointTo exp2) in + let mpt2 = ask_may_point_to ask exp2 in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res @@ -39,7 +44,7 @@ module MayBeEqual = struct | _ -> false in if are_different_arrays || Var.equal (dummy_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t1)) (T.get_var t1) || Var.equal (return_varinfo (T.type_of_term t2)) (T.get_var t2) then false else let exp1 = T.to_cil t1 in - let mpt1 = ask.f (MayPointTo exp1) in + let mpt1 = ask_may_point_to ask exp1 in may_point_to_address ask mpt1 t2 off (**Returns true iff by assigning to t1, the value of t2 could change. From bce1a8c54816d18ead6642aeaa337b2ba3f07073 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 30 Jun 2024 22:51:20 +0200 Subject: [PATCH 175/323] don't answer maypointto query any more --- src/analyses/startStateAnalysis.ml | 2 +- src/analyses/weaklyRelationalPointerAnalysis.ml | 10 +++++----- src/cdomains/congruenceClosure.ml | 3 +++ 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 3816552774..5148d990e4 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -28,7 +28,7 @@ struct let ask_may_point_to (ask: Queries.ask) exp = match ask.f (MayPointTo exp) with - (* | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top() *) + | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top() | res -> res let get_value (ask: Queries.ask) exp = ask_may_point_to ask exp diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 0feb6c5f95..3d4396c18d 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -35,7 +35,7 @@ struct in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res - let query_may_point_to ctx t e = + (* let query_may_point_to ctx t e = if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" d_exp e; match T.of_cil (ask_of_ctx ctx) e with @@ -45,14 +45,14 @@ struct | _,Some cc -> let res = let comp = Disequalities.comp_t cc.uf term in let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 && not (T.is_addr t) in + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in let equal_terms = List.filter valid_term comp in if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); let intersect_query_result res (term,z) = let next_query = let ctx = {ctx with local=Some (init_cc [])} in - match ctx.ask (MayPointTo (T.to_cil_sum Z.(z + offset) (T.to_cil term))) with + match MayBeEqual.ask_may_point_to (ask_of_ctx ctx) (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with | exception (T.UnsupportedCilExpression _) -> MayBeEqual.AD.top() | res -> if MayBeEqual.AD.is_bot res then MayBeEqual.AD.top() else res in @@ -62,7 +62,7 @@ struct d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res end | _ -> - MayBeEqual.AD.top() + MayBeEqual.AD.top() *) let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in @@ -75,7 +75,7 @@ struct end (* TODO Invariant. | Queries.Invariant context -> get_normal_form context*) - | MayPointTo e -> query_may_point_to ctx ctx.local e + (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) | _ -> Result.top q let assign_lval t ask lval expr = diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 08f4743154..9b6422123c 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -63,6 +63,9 @@ module T = struct let rec get_size_in_bits typ = match typ with | TArray (typ, _, _) -> (* we treat arrays like pointers *) get_size_in_bits (TPtr (typ,[])) + | TComp (compinfo, _) -> + if List.is_empty compinfo.cfields then Z.zero else + get_size_in_bits (List.first compinfo.cfields).ftype | _ -> match Z.of_int (bitsSizeOf typ) with | exception GoblintCil__Cil.SizeOfError (msg,_) -> raise (UnsupportedCilExpression msg) | s -> s From f45c6c27bdbf38e4bb6113f7f1497c29ea4fe3e8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 30 Jun 2024 22:51:41 +0200 Subject: [PATCH 176/323] only add valid terms when we add successor terms --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9b6422123c..7c5b77e335 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1483,7 +1483,7 @@ module CongruenceClosure = struct TSet.choose_opt @@ TSet.filter_map (find_successor z) term_set in (* find successor term -> find any element in equivalence class that can be dereferenced *) match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with - | Some successor_term -> if (not @@ predicate successor_term) then + | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then let new_cc = insert_terms new_cc [successor_term] in match LMap.find_opt old_rep_s new_reps with | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) From 27f11b5bf3b093e3bcb02c7846ed45f2aba444ad Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 1 Jul 2024 08:40:31 +0200 Subject: [PATCH 177/323] fix regression test --- src/cdomains/congruenceClosure.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7c5b77e335..2035444e8f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -63,9 +63,9 @@ module T = struct let rec get_size_in_bits typ = match typ with | TArray (typ, _, _) -> (* we treat arrays like pointers *) get_size_in_bits (TPtr (typ,[])) - | TComp (compinfo, _) -> + (* | TComp (compinfo, _) -> if List.is_empty compinfo.cfields then Z.zero else - get_size_in_bits (List.first compinfo.cfields).ftype + get_size_in_bits (List.first compinfo.cfields).ftype *) | _ -> match Z.of_int (bitsSizeOf typ) with | exception GoblintCil__Cil.SizeOfError (msg,_) -> raise (UnsupportedCilExpression msg) | s -> s From 9152fc04821045072b22e15ebe3b684f68049acc Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 2 Jul 2024 11:23:31 +0200 Subject: [PATCH 178/323] fix compare function of propositions and is_struct_type function --- src/cdomains/congruenceClosure.ml | 39 ++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2035444e8f..49619da4c4 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -26,7 +26,7 @@ module T = struct let hash_exp _ = 1 - (* we store the varinfo and the Cil expression corresponding to thi term in the data type *) + (* we store the varinfo and the Cil expression corresponding to the term in the data type *) type t = (Var.t, exp) term [@@deriving eq, ord, hash] type v_prop = (Var.t, exp) prop [@@deriving ord, hash] @@ -38,19 +38,26 @@ module T = struct | Addr _, Deref _ -> -1 | Deref _, Addr _ -> 1 + let normal_form_prop = function + | Equal (t1,t2,z) | Nequal (t1,t2,z) -> + if compare t1 t2 < 0 || (compare t1 t2 = 0 && Z.geq z Z.zero) then (t1,t2,z) else + (t2,t1,Z.(-z)) + (** Two propositions are equal if they are syntactically equal or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) let equal_v_prop p1 p2 = - let equivalent_triple (t1,t2,o1) (t3,t4,o2) = - (equal t1 t3 && equal t2 t4 && Z.equal o1 o2) || - (equal t1 t4 && equal t2 t3 && Z.(equal o1 (-o2))) - in match p1, p2 with - | Equal (a,b,c), Equal (a',b',c') -> equivalent_triple (a,b,c) (a',b',c') - | Nequal (a,b,c), Nequal (a',b',c') -> equivalent_triple (a,b,c) (a',b',c') + match p1, p2 with + | Equal (a,b,c), Equal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) + | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) | _ -> false let compare_v_prop p1 p2 = - if equal_v_prop p1 p2 then 0 else compare_v_prop p1 p2 + match p1, p2 with + | Equal (a,b,c), Equal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) + | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) + | Equal _, Nequal _ -> -1 + | Nequal _, Equal _ -> 1 + let props_equal = List.equal equal_v_prop @@ -64,7 +71,7 @@ module T = struct | TArray (typ, _, _) -> (* we treat arrays like pointers *) get_size_in_bits (TPtr (typ,[])) (* | TComp (compinfo, _) -> - if List.is_empty compinfo.cfields then Z.zero else + if List.is_empty compinfo.cfields then Z.zero else get_size_in_bits (List.first compinfo.cfields).ftype *) | _ -> match Z.of_int (bitsSizeOf typ) with | exception GoblintCil__Cil.SizeOfError (msg,_) -> raise (UnsupportedCilExpression msg) @@ -141,19 +148,23 @@ module T = struct | Some typ -> get_size_in_bits typ | None -> Z.one - let is_array_type = function + let rec is_array_type = function + | TNamed (typinfo, _) -> is_array_type typinfo.ttype | TArray _ -> true | _ -> false - let is_struct_type = function + let rec is_struct_type = function + | TNamed (typinfo, _) -> is_struct_type typinfo.ttype | TComp _ -> true | _ -> false - let is_struct_ptr_type = function - | TPtr(TComp _,_) -> true + let rec is_struct_ptr_type = function + | TNamed (typinfo, _) -> is_struct_ptr_type typinfo.ttype + | TPtr(typ,_) -> is_struct_type typ | _ -> false - let is_ptr_type = function + let rec is_ptr_type = function + | TNamed (typinfo, _) -> is_ptr_type typinfo.ttype | TPtr _ -> true | _ -> false From 2f91d0938b078fd9d36146ab23cd1b8205fdd3a7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 2 Jul 2024 14:48:15 +0200 Subject: [PATCH 179/323] add auxiliaries to to_cil --- src/cdomains/congruenceClosure.ml | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index efbf0e44ea..d0614cf3fe 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -96,7 +96,7 @@ module T = struct let rec show : t -> string = function | Addr v -> "&" ^ Var.show v - | Aux (v,exp) -> Var.show v ^ show_type exp + | Aux (v,exp) -> "~" ^ Var.show v ^ show_type exp | Deref (Addr v, z, exp) when Z.equal z Z.zero -> Var.show v ^ show_type exp | Deref (t, z, exp) when Z.equal z Z.zero -> "*" ^ show t^ show_type exp | Deref (t, z, exp) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")"^ show_type exp @@ -113,12 +113,6 @@ module T = struct (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) let rec contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables - let term_of_varinfo vinfo = (*TODO is this still needed?*) - Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) - - let aux_term_of_varinfo vinfo = - Aux (vinfo, Lval (Var vinfo, NoOffset)) - let eval_int (ask:Queries.ask) exp = match Cilfacade.get_ikind_exp exp with | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") @@ -174,6 +168,15 @@ module T = struct | TPtr _ -> true | _ -> false + let aux_term_of_varinfo vinfo = + Aux (vinfo, Lval (Var vinfo, NoOffset)) + + let term_of_varinfo vinfo = + if is_struct_type vinfo.vtype || vinfo.vaddrof then + Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) + else + aux_term_of_varinfo vinfo + let cil_offs_to_idx (ask: Queries.ask) offs typ = (* TODO: Some duplication with convert_offset in base.ml and cil_offs_to_idx in memOutOfBounds.ml, unclear how to immediately get more reuse *) @@ -351,7 +354,10 @@ module T = struct let res = match lval with | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) - else of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) + else if var.vaddrof then + of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) + else + of_offset ask (Aux (var,Lval (Var var, NoOffset))) off var.vtype (Lval lval) | (Mem exp, off) -> begin match of_cil ask exp with | (Some term, offset) -> From e5431b253298ec47ce3acc9aba349bb1ead36291 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 3 Jul 2024 19:06:37 +0200 Subject: [PATCH 180/323] Shortcut equal --- src/cdomains/weaklyRelationalPointerDomain.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 93b8b03f2e..839459f861 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -105,6 +105,9 @@ module D = struct let name () = "wrpointer" let equal x y = + if x == y then + true + else let res = match x, y with | Some x, Some y -> (T.props_equal (get_normal_form x) (get_normal_form y)) From 049aa0701d651c4d79dd383c73adcbaaed3174b3 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 3 Jul 2024 19:08:14 +0200 Subject: [PATCH 181/323] Shortcut join --- src/cdomains/weaklyRelationalPointerDomain.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 839459f861..b118ff0109 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -126,6 +126,9 @@ module D = struct | Some cc -> TUF.is_empty cc.uf let join a b = + if a == b then + a + else let res = match a,b with | None, b -> b From 9b97233534d96f87a453c27a92c5651d92332cf6 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 3 Jul 2024 19:16:19 +0200 Subject: [PATCH 182/323] Short circuit meet --- src/cdomains/weaklyRelationalPointerDomain.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index b118ff0109..128539b51a 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -142,7 +142,11 @@ module D = struct let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b - let meet a b = match a,b with + let meet a b = + if a == b then + a + else + match a,b with | None, _ -> None | _, None -> None | Some a, b -> From 3397e3b283f73580decb41c850cb237336edd95b Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 3 Jul 2024 19:22:33 +0200 Subject: [PATCH 183/323] Reuse var --- src/analyses/weaklyRelationalPointerAnalysis.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 3d4396c18d..bdda0878e8 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -80,17 +80,19 @@ struct let assign_lval t ask lval expr = (* ignore assignments to values that are not 64 bits *) (*TODO what if there is a cast*) - match T.get_element_size_in_bits (typeOfLval lval), T.of_lval ask lval, T.of_cil ask expr with + let lval_t = typeOfLval lval in + match T.get_element_size_in_bits lval_t, T.of_lval ask lval, T.of_cil ask expr with (* Indefinite assignment *) | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t (* Definite assignment *) | s, lterm, (Some term, Some offset) -> let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in + let dummy_var = MayBeEqual.dummy_var lval_t in if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo (typeOfLval lval) + D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo lval_t | exception (T.UnsupportedCilExpression _) -> D.top () (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. From 990af995c8dd5b2e542af0be7a068ec84598da0e Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 3 Jul 2024 20:18:50 +0200 Subject: [PATCH 184/323] Optimize some calls --- src/cdomains/congruenceClosure.ml | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 49619da4c4..ea90564f3a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -998,6 +998,15 @@ module CongruenceClosure = struct let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list + let fold_atoms f (acc:'a) set:'a = + let exception AtomsDone in + let res = ref acc in + try + TSet.fold (fun (v:T.t) acc -> match v with + | Addr _ -> f acc v + | _ -> res := acc; raise AtomsDone) set acc + with AtomsDone -> !res + let get_atoms set = (* `elements set` returns a sorted list of the elements. The atoms are always smaller that other terms, according to our comparison function. Therefore take_while is enough. *) @@ -1481,7 +1490,7 @@ module CongruenceClosure = struct (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) in let new_reps, new_cc, reachable_old_reps = - List.fold add_atom (TMap.empty, (Some(init_cc [])),[]) (List.filter (not % predicate) @@ SSet.get_atoms cc.set) in + SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some(init_cc [])),[]) cc.set in let cmap = Disequalities.comp_map cc.uf in (* breadth-first search of reachable states *) let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = From 31ff5fb3545e9ae386a60208cbc48556a735a9d6 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 3 Jul 2024 20:48:19 +0200 Subject: [PATCH 185/323] New `find_successor_in_set` --- src/cdomains/congruenceClosure.ml | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index ea90564f3a..81c1098827 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1495,12 +1495,20 @@ module CongruenceClosure = struct (* breadth-first search of reachable states *) let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = let old_rep_s, old_z_s = TUF.find_no_pc cc.uf s_t in - let find_successor z t = - match SSet.deref_term t Z.(s_z-z) cc.set with - | exception (T.UnsupportedCilExpression _) -> None - | successor -> if (not @@ predicate successor) then Some successor else None in let find_successor_in_set (z, term_set) = - TSet.choose_opt @@ TSet.filter_map (find_successor z) term_set in + let exception Found in + let res = ref None in + try + TSet.iter (fun t -> + match SSet.deref_term t Z.(s_z-z) cc.set with + | exception (T.UnsupportedCilExpression _) -> () + | successor -> if (not @@ predicate successor) then + (res := Some successor; raise Found) + else + () + ) term_set; !res + with Found -> !res + in (* find successor term -> find any element in equivalence class that can be dereferenced *) match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then From 55ec00522c2296e26a168b5e941ac5489f26b34c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 10:34:07 +0200 Subject: [PATCH 186/323] support an additional type of dereferencing --- src/cdomains/congruenceClosure.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 49619da4c4..3fc57516b8 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -243,7 +243,7 @@ module T = struct | _ -> false let rec add_index_to_exp exp index = - try if is_struct_type (typeOf exp) || not (is_field index) then + try if is_struct_type (typeOf exp) = (is_field index) then begin match exp with | Lval (Var v, NoOffset) -> Lval (Var v, index) | Lval (Mem v, NoOffset) -> Lval (Mem v, index) @@ -251,6 +251,8 @@ module T = struct add_index_to_exp exp1 index | _ -> raise (UnsupportedCilExpression "not supported yet") end + else if is_struct_ptr_type (typeOf exp) && (is_field index) then + Lval(Mem (exp), index) else raise (UnsupportedCilExpression "Field on a non-compound") with | Cilfacade.TypeOfError _ -> raise (UnsupportedCilExpression "typeOf error") @@ -269,7 +271,8 @@ module T = struct List.filter (function | Equal(t1,t2,z)| Nequal(t1,t2,z) -> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) let dereference_exp exp offset = - let find_field cinfo = try + if M.tracing then M.trace "wrpointer-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); + let res = let find_field cinfo = try Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) with | Not_found -> raise (UnsupportedCilExpression "invalid field offset") in @@ -289,6 +292,7 @@ module T = struct | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) in if check_valid_pointer res then res else raise (UnsupportedCilExpression "not a pointer variable") + in if M.tracing then M.trace "wrpointer-deref" "deref result: %a" d_exp res;res let get_size = get_size_in_bits % type_of_term From fd8ae21ccdbf461ba9f51d09ed822b31dfc386ab Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 10:38:39 +0200 Subject: [PATCH 187/323] fixed indentation --- .../weaklyRelationalPointerAnalysis.ml | 1 - src/cdomains/congruenceClosure.ml | 50 ++++++++++--------- 2 files changed, 26 insertions(+), 25 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index bdda0878e8..c68de29d0f 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -86,7 +86,6 @@ struct | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t (* Definite assignment *) | s, lterm, (Some term, Some offset) -> - let dummy_var = MayBeEqual.dummy_var (typeOfLval lval) in let dummy_var = MayBeEqual.dummy_var lval_t in if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 97dbb014b7..b344927c07 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -272,27 +272,29 @@ module T = struct let dereference_exp exp offset = if M.tracing then M.trace "wrpointer-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); - let res = let find_field cinfo = try - Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) - with | Not_found -> raise (UnsupportedCilExpression "invalid field offset") - in - let res = match exp with - | AddrOf lval -> Lval lval - | _ -> - match typeOf exp with - | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) - | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) - | TArray (typ, _, _) when not (can_be_dereferenced typ) -> - let index = Index (to_cil_constant offset (Some typ), NoOffset) in - begin match exp with - | Lval (Var v, NoOffset) -> Lval (Var v, index) - | Lval (Mem v, NoOffset) -> Lval (Mem v, index) - | _ -> raise (UnsupportedCilExpression "not supported yet") - end - | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) - | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) - in if check_valid_pointer res then res else raise (UnsupportedCilExpression "not a pointer variable") - in if M.tracing then M.trace "wrpointer-deref" "deref result: %a" d_exp res;res + let res = + let find_field cinfo = + try + Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) + with | Not_found -> raise (UnsupportedCilExpression "invalid field offset") + in + let res = match exp with + | AddrOf lval -> Lval lval + | _ -> + match typeOf exp with + | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) + | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) + | TArray (typ, _, _) when not (can_be_dereferenced typ) -> + let index = Index (to_cil_constant offset (Some typ), NoOffset) in + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) + | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) + in if check_valid_pointer res then res else raise (UnsupportedCilExpression "not a pointer variable") + in if M.tracing then M.trace "wrpointer-deref" "deref result: %a" d_exp res;res let get_size = get_size_in_bits % type_of_term @@ -1508,9 +1510,9 @@ module CongruenceClosure = struct | exception (T.UnsupportedCilExpression _) -> () | successor -> if (not @@ predicate successor) then (res := Some successor; raise Found) - else - () - ) term_set; !res + else + () + ) term_set; !res with Found -> !res in (* find successor term -> find any element in equivalence class that can be dereferenced *) From 176dc42d95159fda0f7226b7f692f17892c8b4e9 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 13:15:34 +0200 Subject: [PATCH 188/323] add first code for block disequalities --- src/cdomains/congruenceClosure.ml | 130 +++++++++++++++++++++++++----- 1 file changed, 109 insertions(+), 21 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b344927c07..429679d663 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -8,7 +8,9 @@ module M = Messages exception Unsat type ('v, 't) term = Addr of 'v | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] -type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t [@@deriving eq, ord, hash] +type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t + | BlNequal of ('v, 't) term * ('v, 't) term +[@@deriving eq, ord, hash] (** The terms consist of address constants and dereferencing function with sum of an integer. The dereferencing function is parametrized by the size of the element in the memory. @@ -42,6 +44,9 @@ module T = struct | Equal (t1,t2,z) | Nequal (t1,t2,z) -> if compare t1 t2 < 0 || (compare t1 t2 = 0 && Z.geq z Z.zero) then (t1,t2,z) else (t2,t1,Z.(-z)) + | BlNequal (t1,t2) -> + if compare t1 t2 < 0 then (t1,t2,Z.zero) else + (t2,t1,Z.zero) (** Two propositions are equal if they are syntactically equal or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) @@ -49,15 +54,18 @@ module T = struct match p1, p2 with | Equal (a,b,c), Equal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) + | BlNequal (a,b), BlNequal (a',b') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) | _ -> false let compare_v_prop p1 p2 = match p1, p2 with | Equal (a,b,c), Equal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) - | Equal _, Nequal _ -> -1 - | Nequal _, Equal _ -> 1 - + | BlNequal (a,b), BlNequal (a',b') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) + | Equal _, _ -> -1 + | _, Equal _ -> 1 + | _, BlNequal _ -> -1 + | BlNequal _ , _ -> 1 let props_equal = List.equal equal_v_prop @@ -268,7 +276,7 @@ module T = struct else true let filter_valid_pointers = - List.filter (function | Equal(t1,t2,z)| Nequal(t1,t2,z) -> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) + List.filter (function | Equal(t1,t2,_)| Nequal(t1,t2,_) |BlNequal(t1,t2)-> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) let dereference_exp exp offset = if M.tracing then M.trace "wrpointer-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); @@ -633,6 +641,8 @@ module UnionFind = struct "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class ^ "----\n") "" (get_eq_classes uf) ^ "\n" + let get_representatives uf = + List.filter_map (fun (el,_) -> if is_root uf el then Some el else None) (TMap.bindings uf) end module ZMap = struct @@ -822,6 +832,13 @@ module CongruenceClosure = struct | Some v -> Some v ) + let map_find_all t map = + match TMap.find_opt t map with + | None -> [] + | Some imap -> List.fold (fun list (z,list2) -> + list@list2 + ) [] (ZMap.bindings imap) + let check_neq (_,arg) rest (v,zmap) = let zlist = ZMap.bindings zmap in fold_left2 (fun rest (r1,_) (r2,_) -> @@ -841,12 +858,30 @@ module CongruenceClosure = struct else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 ) rest zlist zlist + let check_neq_bl (uf,arg) rest (t1, tset) = + List.fold (fun rest t2 -> + if Tuple2.eq T.equal Z.equal (TUF.find_no_pc uf t1) (TUF.find_no_pc uf t2) then raise Unsat + else (* r1 <> r2 *) + let l1 = map_find_all t1 arg in + (* just take the elements of set1 ? *) + let l2 = map_find_all t2 arg in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if T.equal v1 v2 then if Z.equal r'1 r'2 + then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 + ) rest (TSet.to_list tset) + (** Initialize the list of disequalities taking only implicit dis-equalities into account. Returns: List of non-trivially implied dis-equalities *) let init_neq (uf,cmap,arg) = List.fold_left (check_neq (uf,arg)) [] (TMap.bindings cmap) + let init_neg_block_diseq (uf, bldis, cmap, arg) = + List.fold_left (check_neq_bl (uf,arg)) [] (TMap.bindings bldis) + + (** Initialize the list of disequalities taking explicit dis-equalities into account. Parameters: union-find partition, explicit disequalities.battrs @@ -973,6 +1008,45 @@ module CongruenceClosure = struct List.concat_map comp_closure diseqs end + (* block disequalities *) + module BlDis = struct + type t = TSet.t TMap.t [@@deriving eq, ord, hash] (* block disequalitites *) + + let bindings = TMap.bindings + let empty = TMap.empty + + let to_conjs bldiseq = List.fold + (fun list (t1, tset) -> + TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list + ) [] (bindings bldiseq) + + let add bldiseq t1 t2 = + match TMap.find_opt t1 bldiseq with + | None -> TMap.add t1 (TSet.singleton t2) bldiseq + | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq + + let add_block_diseq bldiseq t1 t2 = + add (add bldiseq t1 t2) t2 t1 + + (** + params: + + t1-> any term + + tlist: a list of representative terms + + For each term t2 in tlist, it adds the disequality t1' != t2 to diseqs + where t1' is the representative of t1. + Except the block disequality t1' = t1' will not be added, even + if t1' is in tlist. + *) + let add_block_diseqs bldiseq uf t1 tlist = + let t1',_ = TUF.find_no_pc uf t1 in + List.fold (fun bldiseq t2 -> + if T.equal t1' t2 then bldiseq + else add_block_diseq bldiseq t1' t2) bldiseq tlist + end + (** Set of subterms which are present in the current data structure. *) module SSet = struct type t = TSet.t [@@deriving eq, ord, hash] @@ -1141,7 +1215,8 @@ module CongruenceClosure = struct set: SSet.t; map: LMap.t; min_repr: MRMap.t; - diseq: Disequalities.t} + diseq: Disequalities.t; + bldis: BlDis.t} [@@deriving eq, ord, hash] let string_of_prop = function @@ -1149,6 +1224,7 @@ module CongruenceClosure = struct | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 | Nequal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 + | BlNequal (t1,t2) -> "bl(" ^ T.show t1 ^ ") != bl(" ^ T.show t2 ^ ")" let show_conj list = List.fold_left (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list @@ -1194,8 +1270,11 @@ module CongruenceClosure = struct else Nequal (min_state2, min_state1, Z.(-new_offset)) in if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); - let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)) disequalities - in BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities) + let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in + (* block disequalities *) + let conjunctions_of_bl_diseqs = BlDis.to_conjs cc.bldis in + (* all propositions *) + BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) let show_all x = "Normal form:\n" ^ show_conj((get_normal_form x)) ^ @@ -1214,7 +1293,8 @@ module CongruenceClosure = struct and the second one contains all inequality propositions. *) let split conj = List.fold_left (fun (pos,neg) -> function | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg) - | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg)) ([],[]) conj + | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg) + | BlNequal _ -> (pos,neg)) ([],[]) conj (** returns {uf, set, map, min_repr}, where: @@ -1232,7 +1312,7 @@ module CongruenceClosure = struct let uf = SSet.elements set |> TUF.init in let min_repr = MRMap.initial_minimal_representatives set in - {uf; set; map; min_repr; diseq = Disequalities.empty} + {uf; set; map; min_repr; diseq = Disequalities.empty; bldis=BlDis.empty} (** closure of disequalities *) let congruence_neq cc neg = @@ -1241,13 +1321,13 @@ module CongruenceClosure = struct (* getting args of dereferences *) let uf,cmap,arg = Disequalities.get_args cc.uf in (* taking implicit dis-equalities into account *) - let neq_list = Disequalities.init_neq (uf,cmap,arg) in + let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap,arg) in let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) neq_list in (* taking explicit dis-equalities into account *) let neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in if M.tracing then M.trace "wrpointer-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); - Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq} + Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=BlDis.empty} with Unsat -> None (** @@ -1324,7 +1404,7 @@ module CongruenceClosure = struct | None -> None | Some cc -> let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq} [] + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=BlDis.empty} [] (** Parameters: cc conjunctions. @@ -1349,7 +1429,7 @@ module CongruenceClosure = struct (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq} [] + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=BlDis.empty} [] (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = @@ -1380,7 +1460,7 @@ module CongruenceClosure = struct | Addr a -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), Some {uf; set; map = cc.map; min_repr; diseq = cc.diseq}, [Addr a] + (t, Z.zero), Some {uf; set; map = cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty}, [Addr a] | Deref (t', z, exp) -> match insert_no_min_repr cc t' with | (v, r), None, queue -> (v, r), None, [] @@ -1390,10 +1470,10 @@ module CongruenceClosure = struct match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq}) [(t, v', Z.zero)], v::queue + (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty}) [(t, v', Z.zero)], v::queue | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq}, v::queue + (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq; bldis=BlDis.empty}, v::queue (** Add a term to the data structure. @@ -1406,7 +1486,7 @@ module CongruenceClosure = struct | v, None, queue -> v, None | v, Some cc, queue -> let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} + v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty} (** Add all terms in a specific set to the data structure. @@ -1417,7 +1497,7 @@ module CongruenceClosure = struct | Some cc, queue -> (* update min_repr at the end for more efficiency *) let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq} + Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty} (** Returns true if t1 and t2 are equivalent. *) let rec eq_query cc (t1,t2,r) = @@ -1579,8 +1659,8 @@ module CongruenceClosure = struct | Some cc -> let min_repr, uf = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" - (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq}); - Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq} + (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis=BlDis.empty}); + Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis=BlDis.empty} | None -> None end | _,None -> None @@ -1632,4 +1712,12 @@ module CongruenceClosure = struct let res = congruence_neq cc (diseq1 @ diseq2) in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res + let add_block_diseqs cc lterm = + let _, cc = insert cc lterm in + match cc with + | None -> cc + | Some cc -> + let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in + Some {cc with bldis} + end From acc5060c2e7f498c60db78156fd49ccbe2cb973b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 13:16:09 +0200 Subject: [PATCH 189/323] added block diseq handling for malloc --- .../weaklyRelationalPointerAnalysis.ml | 38 +++++++++++++++---- src/cdomains/weaklyRelationalPointerDomain.ml | 2 +- 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index c68de29d0f..a40222fd7e 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -36,10 +36,10 @@ struct d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res (* let query_may_point_to ctx t e = - if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" + if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" d_exp e; - match T.of_cil (ask_of_ctx ctx) e with - | Some term, Some offset -> + match T.of_cil (ask_of_ctx ctx) e with + | Some term, Some offset -> begin match insert t term with | _,None -> MayBeEqual.AD.top() | _,Some cc -> @@ -61,7 +61,7 @@ struct in if M.tracing then M.trace "wrpointer-query" "may-point-to %a : %a. Is bot: %b\n" d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res end - | _ -> + | _ -> MayBeEqual.AD.top() *) let query ctx (type a) (q: a Queries.t): a Queries.result = @@ -127,14 +127,36 @@ struct | None -> ctx.local in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res - let special ctx var_opt v exprs = + + let add_new_block t ask lval = + (* ignore assignments to values that are not 64 bits *) + let lval_t = typeOfLval lval in + match T.get_element_size_in_bits lval_t, T.of_lval ask lval with + (* Indefinite assignment *) + | s, lterm -> + let t = D.remove_may_equal_terms ask s lterm t in + add_block_diseqs t lterm + (* Definite assignment *) + | exception (T.UnsupportedCilExpression _) -> D.top () + + (** var_opt is the variable we assign to. It has type lval. v=malloc.*) + let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in - match desc.special exprs, v.vname with - | Assert { exp; refine; _ }, _ -> if not refine then + match desc.special exprs with + | Assert { exp; refine; _ } -> if not refine then ctx.local else branch ctx exp true - | _, _ -> ctx.local + | Malloc exp -> (*exp is the size of the malloc'ed block*) + begin match var_opt with + | None -> + ctx.local + | Some varin -> + if M.tracing then M.trace "wrpointer-malloc" + "SPECIAL MALLOC: exp = %a; var_opt = Some (%a); v = %a; " d_exp exp d_lval varin d_lval (Var v, NoOffset); + add_new_block ctx.local (ask_of_ctx ctx) varin + end + | _ -> ctx.local let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 128539b51a..81ff936e8a 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -115,7 +115,7 @@ module D = struct | _ -> false in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty} + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis=BlDis.empty} let init () = init_congruence [] From 57c50d773cce8fc1f70388387626d36db5d4994c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 14:05:51 +0200 Subject: [PATCH 190/323] add remove for block disequalities --- src/cdomains/congruenceClosure.ml | 40 +++++++++++++++++++++---------- 1 file changed, 28 insertions(+), 12 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 429679d663..162287e6e6 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1041,7 +1041,8 @@ module CongruenceClosure = struct if t1' is in tlist. *) let add_block_diseqs bldiseq uf t1 tlist = - let t1',_ = TUF.find_no_pc uf t1 in + let t1',_ = t1, t1 in + (* TODO: not a good idea: TUF.find_no_pc uf t1 in *) List.fold (fun bldiseq t2 -> if T.equal t1' t2 then bldiseq else add_block_diseq bldiseq t1' t2) bldiseq tlist @@ -1327,7 +1328,7 @@ module CongruenceClosure = struct let neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in if M.tracing then M.trace "wrpointer-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); - Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=BlDis.empty} + Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=cc.bldis} with Unsat -> None (** @@ -1404,7 +1405,7 @@ module CongruenceClosure = struct | None -> None | Some cc -> let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=BlDis.empty} [] + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=cc.bldis} [] (** Parameters: cc conjunctions. @@ -1429,7 +1430,7 @@ module CongruenceClosure = struct (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=BlDis.empty} [] + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=cc.bldis} [] (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = @@ -1460,7 +1461,7 @@ module CongruenceClosure = struct | Addr a -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), Some {uf; set; map = cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty}, [Addr a] + (t, Z.zero), Some {cc with uf; set; min_repr;}, [Addr a] | Deref (t', z, exp) -> match insert_no_min_repr cc t' with | (v, r), None, queue -> (v, r), None, [] @@ -1470,10 +1471,10 @@ module CongruenceClosure = struct match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty}) [(t, v', Z.zero)], v::queue + (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)], v::queue | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq; bldis=BlDis.empty}, v::queue + (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq; bldis=cc.bldis}, v::queue (** Add a term to the data structure. @@ -1486,7 +1487,7 @@ module CongruenceClosure = struct | v, None, queue -> v, None | v, Some cc, queue -> let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty} + v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} (** Add all terms in a specific set to the data structure. @@ -1497,7 +1498,7 @@ module CongruenceClosure = struct | Some cc, queue -> (* update min_repr at the end for more efficiency *) let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=BlDis.empty} + Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} (** Returns true if t1 and t2 are equivalent. *) let rec eq_query cc (t1,t2,r) = @@ -1647,6 +1648,19 @@ module CongruenceClosure = struct let new_diseq = List.fold add_disequality [] disequalities in congruence_neq cc new_diseq + let remove_terms_from_bldis bldis new_reps cc = + let disequalities = BlDis.to_conjs bldis + in + let add_bl_dis new_diseq = function + | BlNequal (t1,t2) -> + begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with + | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq t1' t2' + | _ -> new_diseq + end + | _-> new_diseq + in + List.fold add_bl_dis BlDis.empty disequalities + (** Remove terms from the data structure. It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) @@ -1657,10 +1671,11 @@ module CongruenceClosure = struct | new_reps, Some cc -> begin match remove_terms_from_diseq old_cc.diseq new_reps cc with | Some cc -> + let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in let min_repr, uf = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" - (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis=BlDis.empty}); - Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis=BlDis.empty} + (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis}); + Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis} | None -> None end | _,None -> None @@ -1713,7 +1728,8 @@ module CongruenceClosure = struct in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res let add_block_diseqs cc lterm = - let _, cc = insert cc lterm in + (* let _, cc = insert cc lterm in + TODO this is very risky....*) match cc with | None -> cc | Some cc -> From 769df6bac3ea45ae14082aa813ac810f01085376 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 14:19:03 +0200 Subject: [PATCH 191/323] implemented equal for block diseqs --- src/cdomains/congruenceClosure.ml | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 162287e6e6..b6eca607aa 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1117,6 +1117,7 @@ module CongruenceClosure = struct let bindings = TMap.bindings let find = TMap.find + let find_opt = TMap.find_opt let add = TMap.add let remove = TMap.remove let mem = TMap.mem @@ -1273,7 +1274,23 @@ module CongruenceClosure = struct if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in (* block disequalities *) - let conjunctions_of_bl_diseqs = BlDis.to_conjs cc.bldis in + let normalize_bldis t = match t with + | BlNequal (t1,t2) -> + let min_state1 = + begin match MRMap.find_opt t1 cc.min_repr with + | None -> t1 + | Some (a,_) -> a + end in + let min_state2 = + begin match MRMap.find_opt t2 cc.min_repr with + | None -> t2 + | Some (a,_) -> a + end in + if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) + else BlNequal (min_state2, min_state1) + | _ -> t + in + let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conjs cc.bldis in (* all propositions *) BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) @@ -1289,6 +1306,8 @@ module CongruenceClosure = struct ^ (MRMap.show_min_rep x.min_repr) ^ "\nNeq:\n" ^ (Disequalities.show_neq x.diseq) + ^ "\nBlock diseqs:\n" + ^ show_conj(BlDis.to_conjs x.bldis) (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) From 376fe8758052252df9ecfff48c6a667d11001315 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 17:38:10 +0200 Subject: [PATCH 192/323] add join for block disequalities --- src/cdomains/congruenceClosure.ml | 96 ++++++++++++++----- src/cdomains/weaklyRelationalPointerDomain.ml | 48 +++++----- 2 files changed, 99 insertions(+), 45 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b6eca607aa..9189306a8d 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -985,8 +985,7 @@ module CongruenceClosure = struct Nequal (t1,t2,Z.(-z)) ) % bindings - let element_closure diseqs uf = - let cmap = comp_map uf in + let element_closure diseqs cmap = let comp_closure (r1,r2,z) = let to_tuple_list = (*TODO this is not the best solution*) List.flatten % List.map @@ -1015,7 +1014,7 @@ module CongruenceClosure = struct let bindings = TMap.bindings let empty = TMap.empty - let to_conjs bldiseq = List.fold + let to_conj bldiseq = List.fold (fun list (t1, tset) -> TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list ) [] (bindings bldiseq) @@ -1025,7 +1024,7 @@ module CongruenceClosure = struct | None -> TMap.add t1 (TSet.singleton t2) bldiseq | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq - let add_block_diseq bldiseq t1 t2 = + let add_block_diseq bldiseq (t1, t2) = add (add bldiseq t1 t2) t2 t1 (** @@ -1045,7 +1044,33 @@ module CongruenceClosure = struct (* TODO: not a good idea: TUF.find_no_pc uf t1 in *) List.fold (fun bldiseq t2 -> if T.equal t1' t2 then bldiseq - else add_block_diseq bldiseq t1' t2) bldiseq tlist + else add_block_diseq bldiseq (t1', t2)) bldiseq tlist + + let element_closure bldis cmap = + let comp_closure = function + | BlNequal (r1,r2) -> + let to_list = (*TODO this is not the best solution*) + List.flatten % List.map + (fun (z, set) -> (TSet.to_list set)) in + let comp_closure_zmap bindings1 bindings2 = + List.cartesian_product (to_list bindings1) (to_list bindings2) + in + let singleton term = [(Z.zero, TSet.singleton term)] in + begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with + | None, None -> [(r1,r2)] + | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) + | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) + | Some zmap1, Some zmap2 -> + comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) + end + | _ -> [] + in + List.concat_map comp_closure bldis + + let map_set_mem v v' (map:t) = match TMap.find_opt v map with + | None -> false + | Some set -> TSet.mem v' set + end (** Set of subterms which are present in the current data structure. *) @@ -1290,7 +1315,7 @@ module CongruenceClosure = struct else BlNequal (min_state2, min_state1) | _ -> t in - let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conjs cc.bldis in + let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in (* all propositions *) BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) @@ -1307,7 +1332,7 @@ module CongruenceClosure = struct ^ "\nNeq:\n" ^ (Disequalities.show_neq x.diseq) ^ "\nBlock diseqs:\n" - ^ show_conj(BlDis.to_conjs x.bldis) + ^ show_conj(BlDis.to_conj x.bldis) (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) @@ -1539,18 +1564,33 @@ module CongruenceClosure = struct | None -> false | Some cc -> fst (eq_query cc (t1,t2,r)) + (*TODO there could be less code duplication *) + let block_neq_query cc (t1,t2) = + (* we implicitly assume that &x != &y + z *) + if T.is_addr t1 && T.is_addr t2 then true else + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + match cc with + | None -> true + | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis + (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = (* we implicitly assume that &x != &y + z *) if T.is_addr t1 && T.is_addr t2 then true else let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in + (* implicit disequalities following from equalities *) if T.equal v1 v2 then if Z.(equal r1 (r2 + r)) then false else true - else match cc with + else + match cc with | None -> true - | Some cc -> Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq + | Some cc -> (* implicit disequalities following from block disequalities *) + BlDis.map_set_mem t1 t2 cc.bldis || + (*explicit dsequalities*) + Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq (** Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = @@ -1572,6 +1612,14 @@ module CongruenceClosure = struct let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in cc + (** adds block disequalities to cc: + fo each representative t in cc it adds the disequality bl(lterm)!=bl(t)*) + let add_block_diseqs cc lterm = + match cc with + | None -> cc + | Some cc -> + let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in + Some {cc with bldis} (* Remove variables: *) @@ -1668,12 +1716,12 @@ module CongruenceClosure = struct in congruence_neq cc new_diseq let remove_terms_from_bldis bldis new_reps cc = - let disequalities = BlDis.to_conjs bldis + let disequalities = BlDis.to_conj bldis in let add_bl_dis new_diseq = function | BlNequal (t1,t2) -> begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with - | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq t1' t2' + | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq (t1', t2') | _ -> new_diseq end | _-> new_diseq @@ -1735,24 +1783,28 @@ module CongruenceClosure = struct add_edges_to_map pmap (Some cc) working_set (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) - let join_neq diseq1 diseq2 cc1 cc2 cc = + let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = let _,diseq1 = split (Disequalities.get_disequalities diseq1) in let _,diseq2 = split (Disequalities.get_disequalities diseq2) in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cc1.uf) in - let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cc2.uf) in + let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1) in + let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2) in let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in let res = congruence_neq cc (diseq1 @ diseq2) in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res - let add_block_diseqs cc lterm = - (* let _, cc = insert cc lterm in - TODO this is very risky....*) - match cc with - | None -> cc - | Some cc -> - let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in - Some {cc with bldis} + (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. *) + let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = + let bldiseq1 = BlDis.to_conj bldiseq1 in + let bldiseq2 = BlDis.to_conj bldiseq2 in + (* keep all disequalities from diseq1 that are implied by cc2 and + those from diseq2 that are implied by cc1 *) + let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1) in + let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2) in + let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in + let bldis = List.fold BlDis.add_block_diseq BlDis.empty (diseq1 @ diseq2) + in (if M.tracing then M.trace "wrpointer-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); + {cc with bldis} end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 81ff936e8a..5f62f7b594 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -108,14 +108,14 @@ module D = struct if x == y then true else - let res = match x, y with - | Some x, Some y -> - (T.props_equal (get_normal_form x) (get_normal_form y)) - | None, None -> true - | _ -> false - in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + let res = match x, y with + | Some x, Some y -> + (T.props_equal (get_normal_form x) (get_normal_form y)) + | None, None -> true + | _ -> false + in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis=BlDis.empty} + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} let init () = init_congruence [] @@ -129,16 +129,18 @@ module D = struct if a == b then a else - let res = - match a,b with - | None, b -> b - | a, None -> a - | Some a, Some b -> let cc = fst(join_eq a b) - in join_neq a.diseq b.diseq a b cc - in - if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" - (show a) (show b) (show res); - res + let res = + match a,b with + | None, b -> b + | a, None -> a + | Some a, Some b -> let cc = fst(join_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) + in + if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" + (show a) (show b) (show res); + res let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b @@ -146,12 +148,12 @@ module D = struct if a == b then a else - match a,b with - | None, _ -> None - | _, None -> None - | Some a, b -> - let a_conj = get_normal_form a in - meet_conjs_opt a_conj b + match a,b with + | None, _ -> None + | _, None -> None + | Some a, b -> + let a_conj = get_normal_form a in + meet_conjs_opt a_conj b let leq x y = equal (meet x y) x From a01beadac189730ffeca6f5a961e1d906a807223 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 4 Jul 2024 18:14:57 +0200 Subject: [PATCH 193/323] update the representatives of block disequalities --- .../weaklyRelationalPointerAnalysis.ml | 3 +- src/cdomains/congruenceClosure.ml | 42 ++++++++++++++----- 2 files changed, 34 insertions(+), 11 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index a40222fd7e..b59f2455aa 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -134,7 +134,8 @@ struct match T.get_element_size_in_bits lval_t, T.of_lval ask lval with (* Indefinite assignment *) | s, lterm -> - let t = D.remove_may_equal_terms ask s lterm t in + (* let t = D.remove_may_equal_terms ask s lterm t in + -> not necessary because this is always a new fresh variable in goblint *) add_block_diseqs t lterm (* Definite assignment *) | exception (T.UnsupportedCilExpression _) -> D.top () diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 9189306a8d..19b00c531e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -611,7 +611,7 @@ module UnionFind = struct returns v,uf,b where - - `v` is the new reference variable of the merged equivalence class. It is either the old reference variable of v1 or of v2, depending on which equivalence class is bigger. + - `v` is the new reference term of the merged equivalence class. It is either the old reference term of v1 or of v2, depending on which equivalence class is bigger. - `uf` is the new union find data structure @@ -1387,23 +1387,27 @@ module CongruenceClosure = struct `queue` is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map. + `new_repr` -> maps each representative to its new representative after the union + Throws "Unsat" if a contradiction is found. *) - let rec closure (uf, map, min_repr) queue = function - | [] -> (uf, map, queue, min_repr) + let rec closure (uf, map, min_repr, new_repr) queue = function + | [] -> (uf, map, queue, min_repr, new_repr) | (t1, t2, r)::rest -> (let v1, r1, uf = TUF.find uf t1 in let v2, r2, uf = TUF.find uf t2 in let sizet1, sizet2 = T.get_size t1, T.get_size t2 in if not (Z.equal sizet1 sizet2) then (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); - closure (uf, map, min_repr) queue rest) else + closure (uf, map, min_repr, new_repr) queue rest) else if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) - if Z.equal r1 Z.(r2 + r) then closure (uf, map, min_repr) queue rest + if Z.equal r1 Z.(r2 + r) then closure (uf, map, min_repr, new_repr) queue rest else raise Unsat else let diff_r = Z.(r2 - r1 + r) in let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) + (* update new_representative *) + let new_repr = if T.equal v v1 then TMap.add v2 v new_repr else TMap.add v1 v new_repr in (* update map *) let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with | None, _, false -> map, rest @@ -1441,15 +1445,30 @@ module CongruenceClosure = struct let removed_v = if b then v2 else v1 in let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in let queue = v :: queue in - closure (uf, map, min_repr) queue rest + closure (uf, map, min_repr, new_repr) queue rest ) + let update_bldis new_repr bldis= + (* update block disequalities with the new representatives *) + let find_new_root t1 = match TMap.find_opt t1 new_repr with + | None -> t1 + | Some v -> v + in + let disequalities = BlDis.to_conj bldis + in (*TODO maybe optimize?, and maybe use this also for removing terms *) + let add_bl_dis new_diseq = function + | BlNequal (t1,t2) ->BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) + | _-> new_diseq + in + List.fold add_bl_dis BlDis.empty disequalities + let closure_no_min_repr cc conjs = match cc with | None -> None | Some cc -> - let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=cc.bldis} [] + let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in + let bldis = update_bldis new_repr cc.bldis in + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] (** Parameters: cc conjunctions. @@ -1470,11 +1489,12 @@ module CongruenceClosure = struct match cc with | None -> None | Some cc -> - let (uf, map, queue, min_repr) = closure (cc.uf, cc.map, cc.min_repr) [] conjs in + let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in + let bldis = update_bldis new_repr cc.bldis in (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=cc.bldis} [] + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = @@ -1598,6 +1618,8 @@ module CongruenceClosure = struct closure cc pos_conjs in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res + (** This does not add any block disequality that may be in conjs + (because we never add them using this function)*) let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs = split conjs in match insert_set (meet_conjs cc pos_conjs) (fst (SSet.subterms_of_conj neg_conjs)) with From 97584b22603a29741926dd9f59a4dff8c4c7597a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 10:16:28 +0200 Subject: [PATCH 194/323] add meet for block disequalities --- src/analyses/weaklyRelationalPointerAnalysis.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index b59f2455aa..3eb8f3d7bd 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -29,9 +29,10 @@ struct let eval_guard ask t e = let prop_list = T.prop_of_cil ask e true in let res = match split prop_list with - | [], [] -> None - | x::xs, _ -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None - | _, y::ys -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None + | [], [], [] -> None + | x::xs, _, [] -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None + | _, y::ys, [] -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None + | _ -> None (*there should never be block disequalities here...*) in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res From c6f0e633ea5bfeefbd4b1fddd79c4065eb2b2f09 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 10:17:03 +0200 Subject: [PATCH 195/323] add meet for block disequalities --- src/cdomains/congruenceClosure.ml | 49 +++++++++++++++++++------------ 1 file changed, 30 insertions(+), 19 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 19b00c531e..fa97777dbc 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -860,10 +860,9 @@ module CongruenceClosure = struct let check_neq_bl (uf,arg) rest (t1, tset) = List.fold (fun rest t2 -> - if Tuple2.eq T.equal Z.equal (TUF.find_no_pc uf t1) (TUF.find_no_pc uf t2) then raise Unsat + if T.equal (fst@@TUF.find_no_pc uf t1) (fst@@TUF.find_no_pc uf t2) then raise Unsat else (* r1 <> r2 *) let l1 = map_find_all t1 arg in - (* just take the elements of set1 ? *) let l2 = map_find_all t2 arg in fold_left2 (fun rest (v1,r'1) (v2,r'2) -> if T.equal v1 v2 then if Z.equal r'1 r'2 @@ -881,7 +880,6 @@ module CongruenceClosure = struct let init_neg_block_diseq (uf, bldis, cmap, arg) = List.fold_left (check_neq_bl (uf,arg)) [] (TMap.bindings bldis) - (** Initialize the list of disequalities taking explicit dis-equalities into account. Parameters: union-find partition, explicit disequalities.battrs @@ -1070,7 +1068,6 @@ module CongruenceClosure = struct let map_set_mem v v' (map:t) = match TMap.find_opt v map with | None -> false | Some set -> TSet.mem v' set - end (** Set of subterms which are present in the current data structure. *) @@ -1336,10 +1333,10 @@ module CongruenceClosure = struct (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) - let split conj = List.fold_left (fun (pos,neg) -> function - | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg) - | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg) - | BlNequal _ -> (pos,neg)) ([],[]) conj + let split conj = List.fold_left (fun (pos,neg,bld) -> function + | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg,bld) + | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg,bld) + | BlNequal (t1,t2) -> (pos,neg,(t1,t2)::bld)) ([],[],[]) conj (** returns {uf, set, map, min_repr}, where: @@ -1362,7 +1359,7 @@ module CongruenceClosure = struct (** closure of disequalities *) let congruence_neq cc neg = try - let neg = snd(split(Disequalities.get_disequalities cc.diseq)) @ neg in + let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in (* getting args of dereferences *) let uf,cmap,arg = Disequalities.get_args cc.uf in (* taking implicit dis-equalities into account *) @@ -1448,7 +1445,7 @@ module CongruenceClosure = struct closure (uf, map, min_repr, new_repr) queue rest ) - let update_bldis new_repr bldis= + let update_bldis new_repr bldis = (* update block disequalities with the new representatives *) let find_new_root t1 = match TMap.find_opt t1 new_repr with | None -> t1 @@ -1462,6 +1459,18 @@ module CongruenceClosure = struct in List.fold add_bl_dis BlDis.empty disequalities + let rec add_normalized_bl_diseqs cc = function + | [] -> cc + | (t1,t2)::bl_conjs -> + match cc with + | None -> None + | Some cc -> + let t1' = fst (TUF.find_no_pc cc.uf t1) in + let t2' = fst (TUF.find_no_pc cc.uf t2) in + if T.equal t1' t2' then None (*unsatisfiable*) + else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in + add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs + let closure_no_min_repr cc conjs = match cc with | None -> None @@ -1612,19 +1621,20 @@ module CongruenceClosure = struct (*explicit dsequalities*) Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq - (** Throws "Unsat" if a contradiction is found. *) + (** Adds equalities to the data structure. + Throws "Unsat" if a contradiction is found. *) let meet_conjs cc pos_conjs = let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in closure cc pos_conjs in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res - (** This does not add any block disequality that may be in conjs - (because we never add them using this function)*) let meet_conjs_opt conjs cc = - let pos_conjs, neg_conjs = split conjs in - match insert_set (meet_conjs cc pos_conjs) (fst (SSet.subterms_of_conj neg_conjs)) with + let pos_conjs, neg_conjs, bl_conjs = split conjs in + let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in + match insert_set (meet_conjs cc pos_conjs) terms_to_add with | exception Unsat -> None - | Some cc -> congruence_neq cc neg_conjs + | Some cc -> let cc = congruence_neq cc neg_conjs in + add_normalized_bl_diseqs cc bl_conjs | None -> None (** Add proposition t1 = t2 + r to the data structure. *) @@ -1806,8 +1816,8 @@ module CongruenceClosure = struct (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = - let _,diseq1 = split (Disequalities.get_disequalities diseq1) in - let _,diseq2 = split (Disequalities.get_disequalities diseq2) in + let _,diseq1,_ = split (Disequalities.get_disequalities diseq1) in + let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1) in @@ -1825,7 +1835,8 @@ module CongruenceClosure = struct let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1) in let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2) in let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in - let bldis = List.fold BlDis.add_block_diseq BlDis.empty (diseq1 @ diseq2) + let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in + let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms in (if M.tracing then M.trace "wrpointer-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); {cc with bldis} From 8642eeb8ec1019a9c899d69153ca6fbd7bc2ce47 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 12:42:08 +0200 Subject: [PATCH 196/323] may point to query for all elements in the equivalence class --- src/cdomains/congruenceClosure.ml | 11 ++--- src/cdomains/weaklyRelationalPointerDomain.ml | 43 ++++++++++++++----- 2 files changed, 37 insertions(+), 17 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2277371633..99cef1ee24 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -368,10 +368,8 @@ module T = struct let res = match lval with | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) - else if var.vaddrof then - of_offset ask (Deref (Addr var, Z.zero, Lval (Var var, NoOffset))) off var.vtype (Lval lval) else - of_offset ask (Aux (var,Lval (Var var, NoOffset))) off var.vtype (Lval lval) + of_offset ask (term_of_varinfo var) off var.vtype (Lval lval) | (Mem exp, off) -> begin match of_cil ask exp with | (Some term, offset) -> @@ -795,12 +793,12 @@ module CongruenceClosure = struct TMap.empty (TMap.bindings uf) (* find all elements that are in the same equivalence class as t - except t*) + except t *) let comp_t uf t = let (t',z') = TUF.find_no_pc uf t in List.fold_left (fun comp (v,((p,z),_)) -> let (v', z'') = TUF.find_no_pc uf v in - if T.equal v' t' && not (T.equal v t) then (v, Z.(z'-z''))::comp else comp + if T.equal v' t' then (v, Z.(z'-z''))::comp else comp ) [] (TMap.bindings uf) @@ -1119,7 +1117,7 @@ module CongruenceClosure = struct let res = ref acc in try TSet.fold (fun (v:T.t) acc -> match v with - | Addr _ -> f acc v + | Addr _| Aux _ -> f acc v | _ -> res := acc; raise AtomsDone) set acc with AtomsDone -> !res @@ -1778,7 +1776,6 @@ module CongruenceClosure = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = let old_cc = cc in - (* first find all terms that need to be removed *) match remove_terms_from_eq predicate cc with | new_reps, Some cc -> begin match remove_terms_from_diseq old_cc.diseq new_reps cc with diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index ed5ab03710..3287ba5a56 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -25,34 +25,57 @@ module MayBeEqual = struct | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () | res -> res + let may_point_to_all_equal_terms ask exp cc term offset = + match cc with + | None -> AD.top() + | Some cc -> + let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + let equal_terms = List.filter valid_term comp in + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); + let intersect_query_result res (term,z) = + let next_query = + match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with + | exception (T.UnsupportedCilExpression _) -> AD.top() + | res -> if AD.is_bot res then AD.top() else res + in + AD.meet res next_query in + List.fold intersect_query_result (AD.top()) equal_terms + (**Find out if two addresses are possibly equal by using the MayPointTo query. *) - let may_point_to_address (ask:Queries.ask) adresses t2 off = + let may_point_to_address (ask:Queries.ask) adresses t2 off cc = match T.to_cil_sum off (T.to_cil t2) with | exception (T.UnsupportedCilExpression _) -> true | exp2 -> let mpt1 = adresses in - let mpt2 = ask_may_point_to ask exp2 in + let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res - let may_point_to_same_address (ask:Queries.ask) t1 t2 off = + let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = if T.equal t1 t2 then true else let exp1 = T.to_cil t1 in - let mpt1 = ask_may_point_to ask exp1 in - may_point_to_address ask mpt1 t2 off + let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in + let res = may_point_to_address ask mpt1 t2 off cc in + if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" + AD.pretty mpt1 (T.show t1) d_plainexp exp1; res + (**Returns true iff by assigning to t1, the value of t2 could change. The parameter s is the size in bits of the variable t1 we are assigning to. *) let rec may_be_equal ask cc s t1 t2 = match t1, t2 with | CC.Deref (t, z,_), CC.Deref (v, z',_) -> + fst(eq_query cc (t,v,Z.(z'-z))) || (* If we have a disequality, then they are not equal *) ( not (neq_query cc (t,v,Z.(z'-z))) (* or if we know that they are not equal according to the query MayPointTo*) && - (may_point_to_same_address ask t v Z.(z' - z)) + (may_point_to_same_address ask t v Z.(z' - z) cc) ) || (may_be_equal ask cc s t1 v) | CC.Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) @@ -63,11 +86,11 @@ module MayBeEqual = struct if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res - let rec may_point_to_one_of_these_adresses ask adresses t2 = + let rec may_point_to_one_of_these_adresses ask adresses cc t2 = match t2 with | CC.Deref (v, z',_) -> - (may_point_to_address ask adresses v z') - || (may_point_to_one_of_these_adresses ask adresses v) + (may_point_to_address ask adresses v z' cc) + || (may_point_to_one_of_these_adresses ask adresses cc v) | CC.Addr _ | CC.Aux _ -> false end @@ -193,6 +216,6 @@ module D = struct It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address)) + Option.bind cc (remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc)) end From 354e4a04a7092adb5cffe0f6b9ededa85e923bb1 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 14:52:40 +0200 Subject: [PATCH 197/323] fixed bug with Casts and auxiliaries and made join more elegant --- src/cdomains/congruenceClosure.ml | 34 ++++++++++++++++++------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 99cef1ee24..06ebccfa57 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -360,7 +360,8 @@ module T = struct end | CastE (typ, exp)-> begin match of_cil ask exp with | Some (Addr x), z -> Some (Addr x), z - | Some (Deref (x, z, old_exp)), z' -> Some (Deref (x, z, CastE (typ, exp))), z' + | Some (Aux (x, _)), z -> Some (Aux (x, CastE (typ, exp))), z + | Some (Deref (x, z, _)), z' -> Some (Deref (x, z, CastE (typ, exp))), z' | t, z -> t, z end | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") @@ -426,7 +427,6 @@ module T = struct None, None) | t, z -> t, z - let map_z_opt op z = Tuple2.map2 (Option.map (op z)) (** Converts a cil expression e = "t1 + off1 - (t2 + off2)" to two terms (Some t1, Some off1), (Some t2, Some off2)*) @@ -792,8 +792,7 @@ module CongruenceClosure = struct map_set_add (TUF.find_no_pc uf v) v comp) TMap.empty (TMap.bindings uf) - (* find all elements that are in the same equivalence class as t - except t *) + (** Find all elements that are in the same equivalence class as t. *) let comp_t uf t = let (t',z') = TUF.find_no_pc uf t in List.fold_left (fun comp (v,((p,z),_)) -> @@ -1590,8 +1589,9 @@ module CongruenceClosure = struct let (v2,r2),cc = insert cc t2 in if T.equal v1 v2 && Z.equal r1 Z.(r2 + r) then (true, cc) else - (*if the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, - i.e. if t1' + z1 = t2' + z2 *) + (* If the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, + i.e. if t1' + z1 = t2' + z2. + This is useful when the dereferenced elements are not pointers. *) if Z.equal r Z.zero then match t1,t2 with | Deref (t1', z1, _), Deref (t2', z2, _) -> @@ -1791,15 +1791,24 @@ module CongruenceClosure = struct (* join *) + let show_pmap pmap= + List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> + s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) + let join_eq cc1 cc2 = let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in let mappings = List.map (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in let r2, off2 = TUF.find_no_pc cc2.uf a in (r1,r2,Z.(off2 - off1)), (a,off1)) atoms in - let pmap = List.fold_left (fun pmap (x1,x2) -> Map.add x1 x2 pmap) Map.empty mappings in - let working_set = List.map fst mappings in - let cc = init_cc [] in + let add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) = + match Map.find_opt new_element pmap with + | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs + | Some (c, c1_off) -> + pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in + let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some (init_cc []),[]) mappings in + (* add equalities that make sure that all atoms that have the same + representative are equal. *) let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = let a', a_off = TUF.find_no_pc cc1.uf a in match LMap.map_find_opt (y, Z.(diff + offset)) cc2.map with @@ -1810,10 +1819,7 @@ module CongruenceClosure = struct | new_term -> let _ , cc = insert cc new_term in let new_element = a',b',Z.(b_off - a_off) in - match Map.find_opt new_element pmap with - | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs - | Some (c, c1_off) -> - pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs + add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) in let rec add_edges_to_map pmap cc = function | [] -> cc, pmap @@ -1822,7 +1828,7 @@ module CongruenceClosure = struct let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off diff) (pmap, cc, []) (LMap.successors x cc1.map) in add_edges_to_map pmap cc (rest@new_pairs) in - add_edges_to_map pmap (Some cc) working_set + add_edges_to_map pmap cc working_set (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = From 814446f871ad5e32fb9f77210e4ac8ebcbf766d3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 14:53:47 +0200 Subject: [PATCH 198/323] fixed may_point_to and implemented query for all elements in equivalence class --- src/cdomains/weaklyRelationalPointerDomain.ml | 78 ++++++++++--------- 1 file changed, 43 insertions(+), 35 deletions(-) diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml index 3287ba5a56..4c7f3aaa61 100644 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ b/src/cdomains/weaklyRelationalPointerDomain.ml @@ -26,23 +26,20 @@ module MayBeEqual = struct | res -> res let may_point_to_all_equal_terms ask exp cc term offset = - match cc with - | None -> AD.top() - | Some cc -> - let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" - d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); - let intersect_query_result res (term,z) = - let next_query = - match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with - | exception (T.UnsupportedCilExpression _) -> AD.top() - | res -> if AD.is_bot res then AD.top() else res - in - AD.meet res next_query in - List.fold intersect_query_result (AD.top()) equal_terms + let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + let equal_terms = List.filter valid_term comp in + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); + let intersect_query_result res (term,z) = + let next_query = + match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with + | exception (T.UnsupportedCilExpression _) -> AD.top() + | res -> if AD.is_bot res then AD.top() else res + in + AD.meet res next_query in + List.fold intersect_query_result (AD.top()) equal_terms (**Find out if two addresses are possibly equal by using the MayPointTo query. *) let may_point_to_address (ask:Queries.ask) adresses t2 off cc = @@ -63,28 +60,36 @@ module MayBeEqual = struct if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" AD.pretty mpt1 (T.show t1) d_plainexp exp1; res - - (**Returns true iff by assigning to t1, the value of t2 could change. - The parameter s is the size in bits of the variable t1 we are assigning to. *) let rec may_be_equal ask cc s t1 t2 = + let there_is_an_overlap s s' diff = + if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) + in match t1, t2 with | CC.Deref (t, z,_), CC.Deref (v, z',_) -> - fst(eq_query cc (t,v,Z.(z'-z))) || - (* If we have a disequality, then they are not equal *) - ( - not (neq_query cc (t,v,Z.(z'-z))) - (* or if we know that they are not equal according to the query MayPointTo*) - && - (may_point_to_same_address ask t v Z.(z' - z) cc) - ) + let (q', z1') = TUF.find_no_pc cc.uf v in + let (q, z1) = TUF.find_no_pc cc.uf t in + let s' = T.get_size t2 in + let diff = Z.(-z' - z1 + z1' + z) in + (* If they are in the same equivalence class and they overlap, then they are equal *) + (if T.equal q' q && there_is_an_overlap s s' diff then true + else + (* If we have a disequality, then they are not equal *) + if neq_query (Some cc) (t,v,Z.(z'-z)) then false else + (* or if we know that they are not equal according to the query MayPointTo*) + (may_point_to_same_address ask t v Z.(z' - z) cc)) || (may_be_equal ask cc s t1 v) | CC.Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) | CC.Addr _ , _ | CC.Aux _, _ -> T.is_subterm t1 t2 + (**Returns true iff by assigning to t1, the value of t2 could change. + The parameter s is the size in bits of the variable t1 we are assigning to. *) let may_be_equal ask cc s t1 t2 = - let res = (may_be_equal ask cc s t1 t2) in - if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; - res + match cc with + | None -> false + | Some cc -> + let res = (may_be_equal ask cc s t1 t2) in + if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + res let rec may_point_to_one_of_these_adresses ask adresses cc t2 = match t2 with @@ -144,13 +149,16 @@ module D = struct match a,b with | None, b -> b | a, None -> a - | Some a, Some b -> let cc = fst(join_eq a b) in + | Some a, Some b -> + if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(join_eq a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) in - if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\nJOIN: %s\n" - (show a) (show b) (show res); + if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" + (show_all res); res let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b @@ -216,6 +224,6 @@ module D = struct It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc)) + Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) end From 4d2f7502bc2dc903479ef9fe01f9ec801fba26c1 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 15:01:06 +0200 Subject: [PATCH 199/323] fix bug that comes from the fact that block disequalities can possibly contain terms that are not in the union find --- src/cdomains/congruenceClosure.ml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 06ebccfa57..cd80d146aa 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -609,6 +609,15 @@ module UnionFind = struct else raise (InvalidUnionFind "non-zero self-distance!") else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) + (** Returns find of v if v is in the union find data structure. + Otherwise it just returns v. *) + let rec find_no_pc_if_possible uf v = + match find_no_pc uf v with + | exception (UnknownValue _) + | exception Not_found + | exception (InvalidUnionFind _) -> v, Z.zero + | res -> res + let compare_repr = Tuple2.compare ~cmp1:T.compare ~cmp2:Z.compare (** Compare only first element of the tuples (= the parent term). @@ -870,7 +879,8 @@ module CongruenceClosure = struct let check_neq_bl (uf,arg) rest (t1, tset) = List.fold (fun rest t2 -> - if T.equal (fst@@TUF.find_no_pc uf t1) (fst@@TUF.find_no_pc uf t2) then raise Unsat + if T.equal (fst@@TUF.find_no_pc_if_possible uf t1) (fst@@TUF.find_no_pc_if_possible uf t2) + then raise Unsat else (* r1 <> r2 *) let l1 = map_find_all t1 arg in let l2 = map_find_all t2 arg in From d8baa37546893a62695038ba5a5137a160f924e6 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 16:44:59 +0200 Subject: [PATCH 200/323] removed some unused rec flags --- src/cdomains/congruenceClosure.ml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index cd80d146aa..4298609a62 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -30,7 +30,7 @@ module T = struct (* we store the varinfo and the Cil expression corresponding to the term in the data type *) type t = (Var.t, exp) term [@@deriving eq, ord, hash] - type v_prop = (Var.t, exp) prop [@@deriving ord, hash] + type v_prop = (Var.t, exp) prop [@@deriving hash] let compare t1 t2 = match t1,t2 with @@ -119,7 +119,7 @@ module T = struct | Deref (t, _, _) -> get_var t (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) - let rec contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables + let contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables let eval_int (ask:Queries.ask) exp = match Cilfacade.get_ikind_exp exp with @@ -151,7 +151,7 @@ module T = struct (** Returns the size of the type. If typ is a pointer, it returns the size of the elements it points to. If typ is an array, it returns the size of the elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int\[]\[]\[] = sizeof(int)). *) - let rec get_element_size_in_bits typ = + let get_element_size_in_bits typ = match type_of_element typ with | Some typ -> get_size_in_bits typ | None -> Z.one @@ -225,7 +225,7 @@ module T = struct | TPtr _| TArray _| TComp _ -> true | _ -> false - let rec type_of_term = + let type_of_term = function | Addr v -> TPtr (v.vtype, []) | Aux (_, exp) | Deref (_, _, exp) -> typeOf exp @@ -315,7 +315,7 @@ module T = struct let get_size = get_size_in_bits % type_of_term - let rec of_offset ask t off typ exp = + let of_offset ask t off typ exp = if off = NoOffset then t else let z = z_of_offset ask off typ in Deref (t, z, exp) @@ -611,7 +611,7 @@ module UnionFind = struct (** Returns find of v if v is in the union find data structure. Otherwise it just returns v. *) - let rec find_no_pc_if_possible uf v = + let find_no_pc_if_possible uf v = match find_no_pc uf v with | exception (UnknownValue _) | exception Not_found @@ -1747,7 +1747,7 @@ module CongruenceClosure = struct (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) - let rec find_new_root new_reps uf v = + let find_new_root new_reps uf v = match TMap.find_opt v new_reps with | None -> None | Some (new_t, z1) -> From 3dd5c5c412b825df9ba9ce144dc2ea6d3c2b4108 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 17:03:08 +0200 Subject: [PATCH 201/323] moved union find to another file --- src/cdomains/congruenceClosure.ml | 733 +---------------------------- src/cdomains/unionFind.ml | 736 ++++++++++++++++++++++++++++++ src/goblint_lib.ml | 1 + 3 files changed, 738 insertions(+), 732 deletions(-) create mode 100644 src/cdomains/unionFind.ml diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 4298609a62..7f7cb9ca09 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1,741 +1,10 @@ (** OCaml implementation of a quantitative congruence closure. *) - +include UnionFind open Batteries open GoblintCil module Var = CilType.Varinfo module M = Messages -exception Unsat - -type ('v, 't) term = Addr of 'v | Aux of 'v * 't | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] -type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t - | BlNequal of ('v, 't) term * ('v, 't) term -[@@deriving eq, ord, hash] - -(** The terms consist of address constants and dereferencing function with sum of an integer. - The dereferencing function is parametrized by the size of the element in the memory. - We store the CIL expression of the term in the data type, such that it it easier to find the types of the dereferenced elements. - Also so that we can easily convert back from term to Cil expression. -*) -module T = struct - type exp = Cil.exp - - let bitsSizeOfPtr () = Z.of_int @@ bitsSizeOf (TPtr (TVoid [],[])) - - (* equality of terms should not depend on the expression *) - let compare_exp _ _ = 0 - let equal_exp _ _ = true - let hash_exp _ = 1 - - - (* we store the varinfo and the Cil expression corresponding to the term in the data type *) - type t = (Var.t, exp) term [@@deriving eq, ord, hash] - type v_prop = (Var.t, exp) prop [@@deriving hash] - - let compare t1 t2 = - match t1,t2 with - | Addr v1, Addr v2 - | Aux (v1,_), Aux (v2,_) -> Var.compare v1 v2 - | Deref (t1,z1,_), Deref (t2,z2,_) -> let c = compare t1 t2 in - if c = 0 then Z.compare z1 z2 else c - | Addr _, _ - | _, Deref _ -> -1 - | _ -> 1 - - let normal_form_prop = function - | Equal (t1,t2,z) | Nequal (t1,t2,z) -> - if compare t1 t2 < 0 || (compare t1 t2 = 0 && Z.geq z Z.zero) then (t1,t2,z) else - (t2,t1,Z.(-z)) - | BlNequal (t1,t2) -> - if compare t1 t2 < 0 then (t1,t2,Z.zero) else - (t2,t1,Z.zero) - - (** Two propositions are equal if they are syntactically equal - or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) - let equal_v_prop p1 p2 = - match p1, p2 with - | Equal (a,b,c), Equal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) - | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) - | BlNequal (a,b), BlNequal (a',b') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) - | _ -> false - - let compare_v_prop p1 p2 = - match p1, p2 with - | Equal (a,b,c), Equal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) - | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) - | BlNequal (a,b), BlNequal (a',b') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) - | Equal _, _ -> -1 - | _, Equal _ -> 1 - | _, BlNequal _ -> -1 - | BlNequal _ , _ -> 1 - - let props_equal = List.equal equal_v_prop - - let is_addr = function - | Addr _ -> true - | _ -> false - - exception UnsupportedCilExpression of string - - let rec get_size_in_bits typ = match typ with - | TArray (typ, _, _) -> (* we treat arrays like pointers *) - get_size_in_bits (TPtr (typ,[])) - (* | TComp (compinfo, _) -> - if List.is_empty compinfo.cfields then Z.zero else - get_size_in_bits (List.first compinfo.cfields).ftype *) - | _ -> match Z.of_int (bitsSizeOf typ) with - | exception GoblintCil__Cil.SizeOfError (msg,_) -> raise (UnsupportedCilExpression msg) - | s -> s - - let show_type exp = - try - let typ = typeOf exp in - "[" ^ (match typ with - | TPtr _ -> "Ptr" - | TInt _ -> "Int" - | TArray _ -> "Arr" - | TVoid _ -> "Voi" - | TFloat (_, _)-> "Flo" - | TComp (_, _) -> "TCo" - | TFun (_, _, _, _)|TNamed (_, _)|TEnum (_, _)|TBuiltin_va_list _ -> "?" - )^ Z.to_string (get_size_in_bits typ) ^ "]" - with - | UnsupportedCilExpression _ -> "[?]" - - let rec show : t -> string = function - | Addr v -> "&" ^ Var.show v - | Aux (v,exp) -> "~" ^ Var.show v ^ show_type exp - | Deref (Addr v, z, exp) when Z.equal z Z.zero -> Var.show v ^ show_type exp - | Deref (t, z, exp) when Z.equal z Z.zero -> "*" ^ show t^ show_type exp - | Deref (t, z, exp) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")"^ show_type exp - - (** Returns true if the first parameter is a subterm of the second one. *) - let rec is_subterm st term = equal st term || match term with - | Deref (t, _, _) -> is_subterm st t - | _ -> false - - let rec get_var = function - | Addr v | Aux (v,_) -> v - | Deref (t, _, _) -> get_var t - - (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) - let contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables - - let eval_int (ask:Queries.ask) exp = - match Cilfacade.get_ikind_exp exp with - | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") - | ikind -> - begin match ask.f (Queries.EvalInt exp) with - | `Lifted i -> - begin match IntDomain.IntDomTuple.to_int @@ IntDomain.IntDomTuple.cast_to ikind i - with - | Some i -> i - | None -> raise (UnsupportedCilExpression "non-constant value") - end - | _ -> raise (UnsupportedCilExpression "non-constant value") - end - - let eval_int_opt (ask:Queries.ask) exp = - match eval_int ask exp with - | i -> Some i - | exception (UnsupportedCilExpression _) -> None - - (*returns Some type for a pointer to a type - and None if the result is not a pointer*) - let rec type_of_element typ = - match typ with - | TArray (typ, _, _) -> type_of_element typ - | TPtr (typ, _) -> Some typ - | _ -> None - - (** Returns the size of the type. If typ is a pointer, it returns the - size of the elements it points to. If typ is an array, it returns the size of the - elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int\[]\[]\[] = sizeof(int)). *) - let get_element_size_in_bits typ = - match type_of_element typ with - | Some typ -> get_size_in_bits typ - | None -> Z.one - - let rec is_array_type = function - | TNamed (typinfo, _) -> is_array_type typinfo.ttype - | TArray _ -> true - | _ -> false - - let rec is_struct_type = function - | TNamed (typinfo, _) -> is_struct_type typinfo.ttype - | TComp _ -> true - | _ -> false - - let rec is_struct_ptr_type = function - | TNamed (typinfo, _) -> is_struct_ptr_type typinfo.ttype - | TPtr(typ,_) -> is_struct_type typ - | _ -> false - - let rec is_ptr_type = function - | TNamed (typinfo, _) -> is_ptr_type typinfo.ttype - | TPtr _ -> true - | _ -> false - - let aux_term_of_varinfo vinfo = - Aux (vinfo, Lval (Var vinfo, NoOffset)) - - let term_of_varinfo vinfo = - if is_struct_type vinfo.vtype || vinfo.vaddrof then - Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) - else - aux_term_of_varinfo vinfo - - let cil_offs_to_idx (ask: Queries.ask) offs typ = - (* TODO: Some duplication with convert_offset in base.ml and cil_offs_to_idx in memOutOfBounds.ml, - unclear how to immediately get more reuse *) - let rec convert_offset (ofs: offset) = - match ofs with - | NoOffset -> `NoOffset - | Field (fld, ofs) -> `Field (fld, convert_offset ofs) - | Index (exp, ofs) when CilType.Exp.equal exp (Lazy.force Offset.Index.Exp.any) -> (* special offset added by convertToQueryLval *) - `Index (ValueDomain.ID.top_of (Cilfacade.get_ikind_exp exp), convert_offset ofs) - | Index (exp, ofs) -> - let i = match ask.f (Queries.EvalInt exp) with - | `Lifted x -> IntDomain.IntDomTuple.cast_to (Cilfacade.ptrdiff_ikind ()) @@ x - | _ -> ValueDomain.ID.top_of @@ Cilfacade.ptrdiff_ikind () - in - `Index (i, convert_offset ofs) - in - let to_constant exp = try let z = eval_int ask exp in - Const (CInt (z, Cilfacade.get_ikind_exp exp, Some (Z.to_string z))) - with Invalid_argument _ | UnsupportedCilExpression _ -> exp - in - let rec convert_type typ = (* compute length of arrays when it is known*) - match typ with - | TArray (typ, exp, attr) -> TArray (convert_type typ, Option.map to_constant exp, attr) - | TPtr (typ, attr) -> TPtr (convert_type typ, attr) - | TFun (typ, form, var_arg, attr) -> TFun (convert_type typ, form, var_arg, attr) - | TNamed (typeinfo, attr) -> TNamed ({typeinfo with ttype=convert_type typeinfo.ttype}, attr) - | TVoid _| TInt (_, _)| TFloat (_, _)| TComp (_, _)| TEnum (_, _)| TBuiltin_va_list _ -> typ - in - PreValueDomain.Offs.to_index ?typ:(Some (convert_type typ)) (convert_offset offs) - - let z_of_offset ask offs typ = - match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with - | Some i -> i - | None - | exception (SizeOfError _) -> raise (UnsupportedCilExpression "unknown offset") - - let can_be_dereferenced = function - | TPtr _| TArray _| TComp _ -> true - | _ -> false - - let type_of_term = - function - | Addr v -> TPtr (v.vtype, []) - | Aux (_, exp) | Deref (_, _, exp) -> typeOf exp - - let to_cil = - function - | (Addr v) -> AddrOf (Var v, NoOffset) - | Aux (_, exp) | (Deref (_, _, exp)) -> exp - - let default_int_type = ILong - (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) - let to_cil_constant z t = - let z = if Z.equal z Z.zero then Z.zero else - let typ_size = match t with - | Some t -> get_element_size_in_bits t - | None -> Z.one - in - if Z.equal typ_size Z.zero then Z.zero else - Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) - - let to_cil_sum off cil_t = - if Z.(equal zero off) then cil_t else - let typ = typeOf cil_t in - BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) - - let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with - | Some i -> i - | None -> raise (UnsupportedCilExpression "unknown offset") - - let is_field = function - | Field _ -> true - | _ -> false - - let rec add_index_to_exp exp index = - try if is_struct_type (typeOf exp) = (is_field index) then - begin match exp with - | Lval (Var v, NoOffset) -> Lval (Var v, index) - | Lval (Mem v, NoOffset) -> Lval (Mem v, index) - | BinOp (PlusPI, exp1, Const (CInt (z, _ , _ )), _)when Z.equal z Z.zero -> - add_index_to_exp exp1 index - | _ -> raise (UnsupportedCilExpression "not supported yet") - end - else if is_struct_ptr_type (typeOf exp) && (is_field index) then - Lval(Mem (exp), index) - else raise (UnsupportedCilExpression "Field on a non-compound") - with | Cilfacade.TypeOfError _ -> raise (UnsupportedCilExpression "typeOf error") - - let is_float = function - | TFloat _ -> true - | _ -> false - - let check_valid_pointer term = - match typeOf term with (* we want to make sure that the expression is valid *) - | exception GoblintCil__Errormsg.Error -> false - | typ -> (* we only track equalties between pointers (variable of size 64)*) - if get_size_in_bits typ <> bitsSizeOfPtr () || is_float typ then false - else true - - let filter_valid_pointers = - List.filter (function | Equal(t1,t2,_)| Nequal(t1,t2,_) |BlNequal(t1,t2)-> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) - - let dereference_exp exp offset = - if M.tracing then M.trace "wrpointer-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); - let res = - let find_field cinfo = - try - Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) - with | Not_found -> raise (UnsupportedCilExpression "invalid field offset") - in - let res = match exp with - | AddrOf lval -> Lval lval - | _ -> - match typeOf exp with - | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) - | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) - | TArray (typ, _, _) when not (can_be_dereferenced typ) -> - let index = Index (to_cil_constant offset (Some typ), NoOffset) in - begin match exp with - | Lval (Var v, NoOffset) -> Lval (Var v, index) - | Lval (Mem v, NoOffset) -> Lval (Mem v, index) - | _ -> raise (UnsupportedCilExpression "not supported yet") - end - | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) - | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) - in if check_valid_pointer res then res else raise (UnsupportedCilExpression "not a pointer variable") - in if M.tracing then M.trace "wrpointer-deref" "deref result: %a" d_exp res;res - - let get_size = get_size_in_bits % type_of_term - - let of_offset ask t off typ exp = - if off = NoOffset then t else - let z = z_of_offset ask off typ in - Deref (t, z, exp) - - (** Converts a cil expression to Some term, Some offset; - or None, Some offset is the expression equals an integer, - or None, None if the expression can't be described by our analysis.*) - let rec of_cil (ask:Queries.ask) e = match e with - | Const (CInt (i, _, _)) -> None, i - | Const _ -> raise (UnsupportedCilExpression "non-integer constant") - | AlignOf _ - | AlignOfE _ -> raise (UnsupportedCilExpression "unsupported AlignOf") - | Lval lval -> Some (of_lval ask lval), Z.zero - | StartOf lval -> Some (of_lval ask lval), Z.zero - | AddrOf (Var var, NoOffset) -> Some (Addr var), Z.zero - | AddrOf (Mem exp, NoOffset) -> of_cil ask exp - | UnOp (op,exp,typ) -> begin match op with - | Neg -> let off = eval_int ask exp in None, Z.(-off) - | _ -> raise (UnsupportedCilExpression "unsupported UnOp") - end - | BinOp (binop, exp1, exp2, typ)-> - let typ1_size = get_element_size_in_bits (Cilfacade.typeOf exp1) in - let typ2_size = get_element_size_in_bits (Cilfacade.typeOf exp2) in - begin match binop with - | PlusA - | PlusPI - | IndexPI -> - begin match eval_int_opt ask exp1, eval_int_opt ask exp2 with - | None, None -> raise (UnsupportedCilExpression "unsupported BinOp +") - | None, Some off2 -> let term, off1 = of_cil ask exp1 in term, Z.(off1 + typ1_size * off2) - | Some off1, None -> let term, off2 = of_cil ask exp2 in term, Z.(typ2_size * off1 + off2) - | Some off1, Some off2 -> None, Z.(off1 + off2) - end - | MinusA - | MinusPI - | MinusPP -> begin match of_cil ask exp1, eval_int_opt ask exp2 with - | (Some term, off1), Some off2 -> let typ1_size = get_element_size_in_bits (Cilfacade.typeOf exp1) in - Some term, Z.(off1 - typ1_size * off2) - | _ -> raise (UnsupportedCilExpression "unsupported BinOp -") - end - | _ -> raise (UnsupportedCilExpression "unsupported BinOp") - end - | CastE (typ, exp)-> begin match of_cil ask exp with - | Some (Addr x), z -> Some (Addr x), z - | Some (Aux (x, _)), z -> Some (Aux (x, CastE (typ, exp))), z - | Some (Deref (x, z, _)), z' -> Some (Deref (x, z, CastE (typ, exp))), z' - | t, z -> t, z - end - | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") - and of_lval ask lval = - let res = - match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) - else - of_offset ask (term_of_varinfo var) off var.vtype (Lval lval) - | (Mem exp, off) -> - begin match of_cil ask exp with - | (Some term, offset) -> - let typ = typeOf exp in - if is_struct_ptr_type typ then - match of_offset ask term off typ (Lval lval) with - | Addr x -> Addr x - | Aux (v,exp) -> Aux (v,exp) - | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) - else - of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) - | _ -> raise (UnsupportedCilExpression "cannot dereference constant") - end - in - (if M.tracing then match res with - | exception (UnsupportedCilExpression s) -> M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s - | t -> M.trace "wrpointer-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show t)) - ;res - - (** Converts the negated expresion to a term if neg = true. - If neg = false then it simply converts the expression to a term. *) - let rec of_cil_neg ask neg e = match e with - | UnOp (op,exp,typ)-> - begin match op with - | Neg -> of_cil_neg ask (not neg) exp - | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e - end - | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e - - let of_cil_neg ask neg e = - match is_float (typeOf e) with - | exception GoblintCil__Errormsg.Error | true -> None, None - | false -> - let res = match of_cil_neg ask neg (Cil.constFold false e) with - | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; - None, None - | t, z -> t, Some z - in (if M.tracing && not neg then match res with - | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) - | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); - | _ -> ()); res - - (** Convert the expression to a term, - and additionally check that the term is 64 bits. - If it's not a 64bit pointer, it returns None, None. *) - let of_cil ask e = - match of_cil_neg ask false e with - | Some t, Some z -> - (* check if t is a valid pointer *) - let exp = to_cil t in - if check_valid_pointer exp then - Some t, Some z - else (if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); - None, None) - | t, z -> t, z - - let map_z_opt op z = Tuple2.map2 (Option.map (op z)) - - (** Converts a cil expression e = "t1 + off1 - (t2 + off2)" to two terms (Some t1, Some off1), (Some t2, Some off2)*) - let rec two_terms_of_cil ask neg e = - let pos_t, neg_t = match e with - | UnOp (Neg,exp,typ) -> two_terms_of_cil ask (not neg) exp - | BinOp (binop, exp1, exp2, typ)-> begin match binop with - | PlusA - | PlusPI - | IndexPI -> begin match of_cil_neg ask false exp1 with - | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask true exp2 in - map_z_opt Z.(+) off1 pos_t, neg_t - | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask true exp2 - | _ -> (None, None), (None, None) - end - | MinusA - | MinusPI - | MinusPP -> begin match of_cil_neg ask false exp1 with - | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask false exp2 in - map_z_opt Z.(+) off1 pos_t, neg_t - | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask false exp2 - | _ -> of_cil_neg ask false e, (None, Some Z.zero) - end - | _ -> of_cil_neg ask false e, (None, Some Z.zero) - end - | _ -> of_cil_neg ask false e, (None, Some Z.zero) - in if neg then neg_t, pos_t else pos_t, neg_t - - (** `prop_of_cil e pos` parses the expression `e` (or `not e` if `pos = false`) and - returns a list of length 1 with the parsed expresion or an empty list if - the expression can't be expressed with the data type `prop`. *) - let rec prop_of_cil ask e pos = - let e = Cil.constFold false e in - match e with - | BinOp (r, e1, e2, _) -> - begin match two_terms_of_cil ask false (BinOp (MinusPI, e1, e2, TInt (Cilfacade.get_ikind_exp e,[]))) with - | ((Some t1, Some z1), (Some t2, Some z2)) -> - begin match r with - | Eq -> if pos then [Equal (t1, t2, Z.(z2-z1))] else [Nequal (t1, t2, Z.(z2-z1))] - | Ne -> if pos then [Nequal (t1, t2, Z.(z2-z1))] else [Equal (t1, t2, Z.(z2-z1))] - | _ -> [] - end - | _,_ -> [] - end - | UnOp (LNot, e1, _) -> prop_of_cil ask e1 (not pos) - | _ -> [] -end - -module TMap = struct - include Map.Make(T) - let hash node_hash y = fold (fun x node acc -> acc + T.hash x + node_hash node) y 0 -end - -module TSet = struct - include Set.Make(T) - let hash x = fold (fun x y -> y + T.hash x) x 0 -end - -(** Quantitative union find *) -module UnionFind = struct - module ValMap = TMap - - (** (value * offset) ref * size of equivalence class *) - type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] - - type t = T.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) - - exception UnknownValue of T.t - exception InvalidUnionFind of string - - let empty = ValMap.empty - - (** create empty union find map, given a list of elements *) - let init = List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) - - (** `parent uf v` returns (p, z) where p is the parent element of - v in the union find tree and z is the offset. - - Throws "Unknown value" if v is not present in the data structure.*) - let parent uf v = match fst (ValMap.find v uf) with - | exception Not_found -> raise (UnknownValue v) - | x -> x - - (** `parent_opt uf v` returns Some (p, z) where p is the parent element of - v in the union find tree and z is the offset. - It returns None if v is not present in the data structure. *) - let parent_opt uf v = Option.map (fun _ -> parent uf v) (ValMap.find_opt v uf) - - let parent_term uf v = fst (parent uf v) - let parent_offset uf v = snd (parent uf v) - let subtree_size uf v = snd (ValMap.find v uf) - - (** Modifies the size of the equivalence class for the current element and - for the whole path to the root of this element. - - The third parameter `modification` is the function to apply to the sizes. *) - let rec modify_size t uf modification = - let (p, old_size) = ValMap.find t uf in - let uf = ValMap.add t (p, modification old_size) uf in - let parent = fst p in - if T.equal parent t then uf else modify_size parent uf modification - - let modify_parent uf v (t, offset) = - let (_, size) = ValMap.find v uf in - ValMap.add v ((t, offset), size) uf - - let modify_offset uf v modification = - let ((t, offset), size) = ValMap.find v uf in - ValMap.add v ((t, modification offset), size) uf - - (** Returns true if each equivalence class in the data structure contains only one element, - i.e. every node is a root. *) - let is_empty uf = List.for_all (fun (v, (t, _)) -> T.equal v (fst t)) (ValMap.bindings uf) - - (** Returns true if v is the representative value of its equivalence class. - - Throws "Unknown value" if v is not present in the data structure. *) - let is_root uf v = let (parent_t, _) = parent uf v in T.equal v parent_t - - (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements - grouped by equivalence classes, while this function just prints them in any order. - - Throws "Unknown value" if v is not present in the data structure. *) - let show_uf_ugly uf = - List.fold_left (fun s (v, (refv, size)) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ T.show v ^ - "; Parent: " ^ T.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") - "" (ValMap.bindings uf) ^ "\n" - - (** - For a variable t it returns the reference variable v and the offset r. - This find performs path compression. - It returns als the updated union-find tree after the path compression. - - Throws "Unknown value" if t is not present in the data structure. - Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. - *) - let find uf v = - let (v',r') = parent uf v in - if T.equal v' v then - (* v is a root *) - if Z.equal r' Z.zero then v',r', uf - else raise (InvalidUnionFind "non-zero self-distance!") - else if is_root uf v' then - (* the parent of v is a root *) - v',r', uf - else - let rec search v list = - let (v',r') = parent uf v in - if is_root uf v' then - (* perform path compresion *) - let (r',uf) = List.fold_left (fun (r0, uf) v -> - let (parent_v, r''), size_v = ValMap.find v uf in - let uf = modify_parent uf v (v',Z.(r0+r'')) in - let uf = modify_size parent_v uf (fun s -> s - size_v) in - let uf = modify_size v' uf ((+) size_v) - in Z.(r0+r''),uf) (Z.zero, uf) (v::list) - in v',r',uf - else search v' (v :: list) - in search v' [v] - - (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) - let find_opt uf v = match find uf v with - | exception (UnknownValue _) - | exception Not_found - | exception (InvalidUnionFind _) -> None - | res -> Some res - - (** - For a variable t it returns the reference variable v and the offset r. - This find DOES NOT perform path compression. - - Throws "Unknown value" if t is not present in the data structure. - Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. - *) - let rec find_no_pc uf v = - let (v',r') = parent uf v in - if T.equal v' v then - if Z.equal r' Z.zero then (v',r') - else raise (InvalidUnionFind "non-zero self-distance!") - else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) - - (** Returns find of v if v is in the union find data structure. - Otherwise it just returns v. *) - let find_no_pc_if_possible uf v = - match find_no_pc uf v with - | exception (UnknownValue _) - | exception Not_found - | exception (InvalidUnionFind _) -> v, Z.zero - | res -> res - - let compare_repr = Tuple2.compare ~cmp1:T.compare ~cmp2:Z.compare - - (** Compare only first element of the tuples (= the parent term). - It ignores the offset. *) - let compare_repr_v (v1, _) (v2, _) = T.compare v1 v2 - - (** - Parameters: uf v1 v2 r - - changes the union find data structure `uf` such that the equivalence classes of `v1` and `v2` are merged and `v1 = v2 + r` - - returns v,uf,b where - - - `v` is the new reference term of the merged equivalence class. It is either the old reference term of v1 or of v2, depending on which equivalence class is bigger. - - - `uf` is the new union find data structure - - - `b` is true iff v = find v1 - - *) - let union uf v'1 v'2 r = - let v1,r1,uf = find uf v'1 in - let v2,r2,uf = find uf v'2 in - if T.equal v1 v2 then - if Z.(equal r1 (r2 + r)) then v1, uf, true - else raise (Failure "incomparable union") - else let (_,s1), (_,s2) = ValMap.find v1 uf, ValMap.find v2 uf in - if s1 <= s2 then ( - v2, modify_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false - ) else ( - v1, modify_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true - ) - - (** Returns a list of equivalence classes. *) - let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) - - (** Throws "Unknown value" if the data structure is invalid. *) - let show_uf uf = List.fold_left (fun s eq_class -> - s ^ List.fold_left (fun s (v, (t, size)) -> - s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^T.show v ^ "; P: " ^ T.show (fst t) ^ - "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class - ^ "----\n") "" (get_eq_classes uf) ^ "\n" - - let get_representatives uf = - List.filter_map (fun (el,_) -> if is_root uf el then Some el else None) (TMap.bindings uf) -end - -module ZMap = struct - include Map.Make(Z) - let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 -end - -(** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a term in the data structure that is equal to *(z + t').*) -module LookupMap = struct - (* map: term -> z -> *(z + t) *) - type t = T.t ZMap.t TMap.t [@@deriving eq, ord, hash] - - let bindings = TMap.bindings - let add = TMap.add - let remove = TMap.remove - let empty = TMap.empty - let find_opt = TMap.find_opt - let find = TMap.find - - let zmap_bindings = ZMap.bindings - let zmap_find_opt = ZMap.find_opt - let zmap_add = ZMap.add - - (** Returns the element to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) - let map_find_opt (v,r) (map:t) = match find_opt v map with - | None -> None - | Some zmap -> (match zmap_find_opt r zmap with - | None -> None - | Some v -> Some v - ) - - let map_add (v,r) v' (map:t) = match find_opt v map with - | None -> add v (zmap_add r v' ZMap.empty) map - | Some zmap -> add v (zmap_add r v' zmap) map - - let show_map (map:t) = - List.fold_left - (fun s (v, zmap) -> - s ^ T.show v ^ "\t:\n" ^ - List.fold_left - (fun s (r, v) -> - s ^ "\t" ^ Z.to_string r ^ ": " ^ T.show v ^ "; ") - "" (zmap_bindings zmap) ^ "\n") - "" (bindings map) - - (** The value at v' is shifted by r and then added for v. - The old entry for v' is removed. *) - let shift v r v' map = - match find_opt v' map with - | None -> map - | Some zmap -> let infl = zmap_bindings zmap in - let zmap = List.fold_left (fun zmap (r', v') -> - zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in - remove v' (add v zmap map) - - (** Find all outgoing edges of v in the automata.*) - let successors v (map:t) = - match find_opt v map with - | None -> [] - | Some zmap -> zmap_bindings zmap - - (** Filters elements from the mapped values which fulfil the predicate p. *) - let filter_if (map:t) p = - TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter (fun key value -> p value) zmap - in if ZMap.is_empty zmap then None else Some zmap) map - - (** Maps elements from the mapped values by applying the function f to them. *) - let map_values (map:t) f = - TMap.map (fun zmap -> - ZMap.map f zmap) map -end - (** Quantitative congruence closure on terms *) module CongruenceClosure = struct diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml new file mode 100644 index 0000000000..00158da205 --- /dev/null +++ b/src/cdomains/unionFind.ml @@ -0,0 +1,736 @@ + +open Batteries +open GoblintCil +module Var = CilType.Varinfo +module M = Messages + +exception Unsat + +type ('v, 't) term = Addr of 'v | Aux of 'v * 't | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] +type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t + | BlNequal of ('v, 't) term * ('v, 't) term +[@@deriving eq, ord, hash] + +(** The terms consist of address constants and dereferencing function with sum of an integer. + The dereferencing function is parametrized by the size of the element in the memory. + We store the CIL expression of the term in the data type, such that it it easier to find the types of the dereferenced elements. + Also so that we can easily convert back from term to Cil expression. +*) +module T = struct + type exp = Cil.exp + + let bitsSizeOfPtr () = Z.of_int @@ bitsSizeOf (TPtr (TVoid [],[])) + + (* equality of terms should not depend on the expression *) + let compare_exp _ _ = 0 + let equal_exp _ _ = true + let hash_exp _ = 1 + + + (* we store the varinfo and the Cil expression corresponding to the term in the data type *) + type t = (Var.t, exp) term [@@deriving eq, ord, hash] + type v_prop = (Var.t, exp) prop [@@deriving hash] + + let compare t1 t2 = + match t1,t2 with + | Addr v1, Addr v2 + | Aux (v1,_), Aux (v2,_) -> Var.compare v1 v2 + | Deref (t1,z1,_), Deref (t2,z2,_) -> let c = compare t1 t2 in + if c = 0 then Z.compare z1 z2 else c + | Addr _, _ + | _, Deref _ -> -1 + | _ -> 1 + + let normal_form_prop = function + | Equal (t1,t2,z) | Nequal (t1,t2,z) -> + if compare t1 t2 < 0 || (compare t1 t2 = 0 && Z.geq z Z.zero) then (t1,t2,z) else + (t2,t1,Z.(-z)) + | BlNequal (t1,t2) -> + if compare t1 t2 < 0 then (t1,t2,Z.zero) else + (t2,t1,Z.zero) + + (** Two propositions are equal if they are syntactically equal + or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) + let equal_v_prop p1 p2 = + match p1, p2 with + | Equal (a,b,c), Equal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) + | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) + | BlNequal (a,b), BlNequal (a',b') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) + | _ -> false + + let compare_v_prop p1 p2 = + match p1, p2 with + | Equal (a,b,c), Equal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) + | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) + | BlNequal (a,b), BlNequal (a',b') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) + | Equal _, _ -> -1 + | _, Equal _ -> 1 + | _, BlNequal _ -> -1 + | BlNequal _ , _ -> 1 + + let props_equal = List.equal equal_v_prop + + let is_addr = function + | Addr _ -> true + | _ -> false + + exception UnsupportedCilExpression of string + + let rec get_size_in_bits typ = match typ with + | TArray (typ, _, _) -> (* we treat arrays like pointers *) + get_size_in_bits (TPtr (typ,[])) + (* | TComp (compinfo, _) -> + if List.is_empty compinfo.cfields then Z.zero else + get_size_in_bits (List.first compinfo.cfields).ftype *) + | _ -> match Z.of_int (bitsSizeOf typ) with + | exception GoblintCil__Cil.SizeOfError (msg,_) -> raise (UnsupportedCilExpression msg) + | s -> s + + let show_type exp = + try + let typ = typeOf exp in + "[" ^ (match typ with + | TPtr _ -> "Ptr" + | TInt _ -> "Int" + | TArray _ -> "Arr" + | TVoid _ -> "Voi" + | TFloat (_, _)-> "Flo" + | TComp (_, _) -> "TCo" + | TFun (_, _, _, _)|TNamed (_, _)|TEnum (_, _)|TBuiltin_va_list _ -> "?" + )^ Z.to_string (get_size_in_bits typ) ^ "]" + with + | UnsupportedCilExpression _ -> "[?]" + + let rec show : t -> string = function + | Addr v -> "&" ^ Var.show v + | Aux (v,exp) -> "~" ^ Var.show v ^ show_type exp + | Deref (Addr v, z, exp) when Z.equal z Z.zero -> Var.show v ^ show_type exp + | Deref (t, z, exp) when Z.equal z Z.zero -> "*" ^ show t^ show_type exp + | Deref (t, z, exp) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")"^ show_type exp + + (** Returns true if the first parameter is a subterm of the second one. *) + let rec is_subterm st term = equal st term || match term with + | Deref (t, _, _) -> is_subterm st t + | _ -> false + + let rec get_var = function + | Addr v | Aux (v,_) -> v + | Deref (t, _, _) -> get_var t + + (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) + let contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables + + let eval_int (ask:Queries.ask) exp = + match Cilfacade.get_ikind_exp exp with + | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") + | ikind -> + begin match ask.f (Queries.EvalInt exp) with + | `Lifted i -> + begin match IntDomain.IntDomTuple.to_int @@ IntDomain.IntDomTuple.cast_to ikind i + with + | Some i -> i + | None -> raise (UnsupportedCilExpression "non-constant value") + end + | _ -> raise (UnsupportedCilExpression "non-constant value") + end + + let eval_int_opt (ask:Queries.ask) exp = + match eval_int ask exp with + | i -> Some i + | exception (UnsupportedCilExpression _) -> None + + (*returns Some type for a pointer to a type + and None if the result is not a pointer*) + let rec type_of_element typ = + match typ with + | TArray (typ, _, _) -> type_of_element typ + | TPtr (typ, _) -> Some typ + | _ -> None + + (** Returns the size of the type. If typ is a pointer, it returns the + size of the elements it points to. If typ is an array, it returns the size of the + elements of the array (even if it is a multidimensional array. Therefore get_element_size_in_bits int\[]\[]\[] = sizeof(int)). *) + let get_element_size_in_bits typ = + match type_of_element typ with + | Some typ -> get_size_in_bits typ + | None -> Z.one + + let rec is_array_type = function + | TNamed (typinfo, _) -> is_array_type typinfo.ttype + | TArray _ -> true + | _ -> false + + let rec is_struct_type = function + | TNamed (typinfo, _) -> is_struct_type typinfo.ttype + | TComp _ -> true + | _ -> false + + let rec is_struct_ptr_type = function + | TNamed (typinfo, _) -> is_struct_ptr_type typinfo.ttype + | TPtr(typ,_) -> is_struct_type typ + | _ -> false + + let rec is_ptr_type = function + | TNamed (typinfo, _) -> is_ptr_type typinfo.ttype + | TPtr _ -> true + | _ -> false + + let aux_term_of_varinfo vinfo = + Aux (vinfo, Lval (Var vinfo, NoOffset)) + + let term_of_varinfo vinfo = + if is_struct_type vinfo.vtype || vinfo.vaddrof then + Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) + else + aux_term_of_varinfo vinfo + + let cil_offs_to_idx (ask: Queries.ask) offs typ = + (* TODO: Some duplication with convert_offset in base.ml and cil_offs_to_idx in memOutOfBounds.ml, + unclear how to immediately get more reuse *) + let rec convert_offset (ofs: offset) = + match ofs with + | NoOffset -> `NoOffset + | Field (fld, ofs) -> `Field (fld, convert_offset ofs) + | Index (exp, ofs) when CilType.Exp.equal exp (Lazy.force Offset.Index.Exp.any) -> (* special offset added by convertToQueryLval *) + `Index (ValueDomain.ID.top_of (Cilfacade.get_ikind_exp exp), convert_offset ofs) + | Index (exp, ofs) -> + let i = match ask.f (Queries.EvalInt exp) with + | `Lifted x -> IntDomain.IntDomTuple.cast_to (Cilfacade.ptrdiff_ikind ()) @@ x + | _ -> ValueDomain.ID.top_of @@ Cilfacade.ptrdiff_ikind () + in + `Index (i, convert_offset ofs) + in + let to_constant exp = try let z = eval_int ask exp in + Const (CInt (z, Cilfacade.get_ikind_exp exp, Some (Z.to_string z))) + with Invalid_argument _ | UnsupportedCilExpression _ -> exp + in + let rec convert_type typ = (* compute length of arrays when it is known*) + match typ with + | TArray (typ, exp, attr) -> TArray (convert_type typ, Option.map to_constant exp, attr) + | TPtr (typ, attr) -> TPtr (convert_type typ, attr) + | TFun (typ, form, var_arg, attr) -> TFun (convert_type typ, form, var_arg, attr) + | TNamed (typeinfo, attr) -> TNamed ({typeinfo with ttype=convert_type typeinfo.ttype}, attr) + | TVoid _| TInt (_, _)| TFloat (_, _)| TComp (_, _)| TEnum (_, _)| TBuiltin_va_list _ -> typ + in + PreValueDomain.Offs.to_index ?typ:(Some (convert_type typ)) (convert_offset offs) + + let z_of_offset ask offs typ = + match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with + | Some i -> i + | None + | exception (SizeOfError _) -> raise (UnsupportedCilExpression "unknown offset") + + let can_be_dereferenced = function + | TPtr _| TArray _| TComp _ -> true + | _ -> false + + let type_of_term = + function + | Addr v -> TPtr (v.vtype, []) + | Aux (_, exp) | Deref (_, _, exp) -> typeOf exp + + let to_cil = + function + | (Addr v) -> AddrOf (Var v, NoOffset) + | Aux (_, exp) | (Deref (_, _, exp)) -> exp + + let default_int_type = ILong + (** Returns a Cil expression which is the constant z divided by the size of the elements of t.*) + let to_cil_constant z t = + let z = if Z.equal z Z.zero then Z.zero else + let typ_size = match t with + | Some t -> get_element_size_in_bits t + | None -> Z.one + in + if Z.equal typ_size Z.zero then Z.zero else + Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) + + let to_cil_sum off cil_t = + if Z.(equal zero off) then cil_t else + let typ = typeOf cil_t in + BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) + + let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with + | Some i -> i + | None -> raise (UnsupportedCilExpression "unknown offset") + + let is_field = function + | Field _ -> true + | _ -> false + + let rec add_index_to_exp exp index = + try if is_struct_type (typeOf exp) = (is_field index) then + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | BinOp (PlusPI, exp1, Const (CInt (z, _ , _ )), _)when Z.equal z Z.zero -> + add_index_to_exp exp1 index + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + else if is_struct_ptr_type (typeOf exp) && (is_field index) then + Lval(Mem (exp), index) + else raise (UnsupportedCilExpression "Field on a non-compound") + with | Cilfacade.TypeOfError _ -> raise (UnsupportedCilExpression "typeOf error") + + let is_float = function + | TFloat _ -> true + | _ -> false + + let check_valid_pointer term = + match typeOf term with (* we want to make sure that the expression is valid *) + | exception GoblintCil__Errormsg.Error -> false + | typ -> (* we only track equalties between pointers (variable of size 64)*) + if get_size_in_bits typ <> bitsSizeOfPtr () || is_float typ then false + else true + + let filter_valid_pointers = + List.filter (function | Equal(t1,t2,_)| Nequal(t1,t2,_) |BlNequal(t1,t2)-> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) + + let dereference_exp exp offset = + if M.tracing then M.trace "wrpointer-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); + let res = + let find_field cinfo = + try + Field (List.find (fun field -> Z.equal (get_field_offset field) offset) cinfo.cfields, NoOffset) + with | Not_found -> raise (UnsupportedCilExpression "invalid field offset") + in + let res = match exp with + | AddrOf lval -> Lval lval + | _ -> + match typeOf exp with + | TPtr (TComp (cinfo, _), _) -> add_index_to_exp exp (find_field cinfo) + | TPtr (typ, _) -> Lval (Mem (to_cil_sum offset exp), NoOffset) + | TArray (typ, _, _) when not (can_be_dereferenced typ) -> + let index = Index (to_cil_constant offset (Some typ), NoOffset) in + begin match exp with + | Lval (Var v, NoOffset) -> Lval (Var v, index) + | Lval (Mem v, NoOffset) -> Lval (Mem v, index) + | _ -> raise (UnsupportedCilExpression "not supported yet") + end + | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) + | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) + in if check_valid_pointer res then res else raise (UnsupportedCilExpression "not a pointer variable") + in if M.tracing then M.trace "wrpointer-deref" "deref result: %a" d_exp res;res + + let get_size = get_size_in_bits % type_of_term + + let of_offset ask t off typ exp = + if off = NoOffset then t else + let z = z_of_offset ask off typ in + Deref (t, z, exp) + + (** Converts a cil expression to Some term, Some offset; + or None, Some offset is the expression equals an integer, + or None, None if the expression can't be described by our analysis.*) + let rec of_cil (ask:Queries.ask) e = match e with + | Const (CInt (i, _, _)) -> None, i + | Const _ -> raise (UnsupportedCilExpression "non-integer constant") + | AlignOf _ + | AlignOfE _ -> raise (UnsupportedCilExpression "unsupported AlignOf") + | Lval lval -> Some (of_lval ask lval), Z.zero + | StartOf lval -> Some (of_lval ask lval), Z.zero + | AddrOf (Var var, NoOffset) -> Some (Addr var), Z.zero + | AddrOf (Mem exp, NoOffset) -> of_cil ask exp + | UnOp (op,exp,typ) -> begin match op with + | Neg -> let off = eval_int ask exp in None, Z.(-off) + | _ -> raise (UnsupportedCilExpression "unsupported UnOp") + end + | BinOp (binop, exp1, exp2, typ)-> + let typ1_size = get_element_size_in_bits (Cilfacade.typeOf exp1) in + let typ2_size = get_element_size_in_bits (Cilfacade.typeOf exp2) in + begin match binop with + | PlusA + | PlusPI + | IndexPI -> + begin match eval_int_opt ask exp1, eval_int_opt ask exp2 with + | None, None -> raise (UnsupportedCilExpression "unsupported BinOp +") + | None, Some off2 -> let term, off1 = of_cil ask exp1 in term, Z.(off1 + typ1_size * off2) + | Some off1, None -> let term, off2 = of_cil ask exp2 in term, Z.(typ2_size * off1 + off2) + | Some off1, Some off2 -> None, Z.(off1 + off2) + end + | MinusA + | MinusPI + | MinusPP -> begin match of_cil ask exp1, eval_int_opt ask exp2 with + | (Some term, off1), Some off2 -> let typ1_size = get_element_size_in_bits (Cilfacade.typeOf exp1) in + Some term, Z.(off1 - typ1_size * off2) + | _ -> raise (UnsupportedCilExpression "unsupported BinOp -") + end + | _ -> raise (UnsupportedCilExpression "unsupported BinOp") + end + | CastE (typ, exp)-> begin match of_cil ask exp with + | Some (Addr x), z -> Some (Addr x), z + | Some (Aux (x, _)), z -> Some (Aux (x, CastE (typ, exp))), z + | Some (Deref (x, z, _)), z' -> Some (Deref (x, z, CastE (typ, exp))), z' + | t, z -> t, z + end + | _ -> raise (UnsupportedCilExpression "unsupported Cil Expression") + and of_lval ask lval = + let res = + match lval with + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) + else + of_offset ask (term_of_varinfo var) off var.vtype (Lval lval) + | (Mem exp, off) -> + begin match of_cil ask exp with + | (Some term, offset) -> + let typ = typeOf exp in + if is_struct_ptr_type typ then + match of_offset ask term off typ (Lval lval) with + | Addr x -> Addr x + | Aux (v,exp) -> Aux (v,exp) + | Deref (x, z, exp) -> Deref (x, Z.(z+offset), exp) + else + of_offset ask (Deref (term, offset, Lval(Mem exp, NoOffset))) off (typeOfLval (Mem exp, NoOffset)) (Lval lval) + | _ -> raise (UnsupportedCilExpression "cannot dereference constant") + end + in + (if M.tracing then match res with + | exception (UnsupportedCilExpression s) -> M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s + | t -> M.trace "wrpointer-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show t)) + ;res + + (** Converts the negated expresion to a term if neg = true. + If neg = false then it simply converts the expression to a term. *) + let rec of_cil_neg ask neg e = match e with + | UnOp (op,exp,typ)-> + begin match op with + | Neg -> of_cil_neg ask (not neg) exp + | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e + end + | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e + + let of_cil_neg ask neg e = + match is_float (typeOf e) with + | exception GoblintCil__Errormsg.Error | true -> None, None + | false -> + let res = match of_cil_neg ask neg (Cil.constFold false e) with + | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; + None, None + | t, z -> t, Some z + in (if M.tracing && not neg then match res with + | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) + | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); + | _ -> ()); res + + (** Convert the expression to a term, + and additionally check that the term is 64 bits. + If it's not a 64bit pointer, it returns None, None. *) + let of_cil ask e = + match of_cil_neg ask false e with + | Some t, Some z -> + (* check if t is a valid pointer *) + let exp = to_cil t in + if check_valid_pointer exp then + Some t, Some z + else (if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); + None, None) + | t, z -> t, z + + let map_z_opt op z = Tuple2.map2 (Option.map (op z)) + + (** Converts a cil expression e = "t1 + off1 - (t2 + off2)" to two terms (Some t1, Some off1), (Some t2, Some off2)*) + let rec two_terms_of_cil ask neg e = + let pos_t, neg_t = match e with + | UnOp (Neg,exp,typ) -> two_terms_of_cil ask (not neg) exp + | BinOp (binop, exp1, exp2, typ)-> begin match binop with + | PlusA + | PlusPI + | IndexPI -> begin match of_cil_neg ask false exp1 with + | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask true exp2 in + map_z_opt Z.(+) off1 pos_t, neg_t + | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask true exp2 + | _ -> (None, None), (None, None) + end + | MinusA + | MinusPI + | MinusPP -> begin match of_cil_neg ask false exp1 with + | (None, Some off1) -> let pos_t, neg_t = two_terms_of_cil ask false exp2 in + map_z_opt Z.(+) off1 pos_t, neg_t + | (Some term, Some off1) -> (Some term, Some off1), of_cil_neg ask false exp2 + | _ -> of_cil_neg ask false e, (None, Some Z.zero) + end + | _ -> of_cil_neg ask false e, (None, Some Z.zero) + end + | _ -> of_cil_neg ask false e, (None, Some Z.zero) + in if neg then neg_t, pos_t else pos_t, neg_t + + (** `prop_of_cil e pos` parses the expression `e` (or `not e` if `pos = false`) and + returns a list of length 1 with the parsed expresion or an empty list if + the expression can't be expressed with the data type `prop`. *) + let rec prop_of_cil ask e pos = + let e = Cil.constFold false e in + match e with + | BinOp (r, e1, e2, _) -> + begin match two_terms_of_cil ask false (BinOp (MinusPI, e1, e2, TInt (Cilfacade.get_ikind_exp e,[]))) with + | ((Some t1, Some z1), (Some t2, Some z2)) -> + begin match r with + | Eq -> if pos then [Equal (t1, t2, Z.(z2-z1))] else [Nequal (t1, t2, Z.(z2-z1))] + | Ne -> if pos then [Nequal (t1, t2, Z.(z2-z1))] else [Equal (t1, t2, Z.(z2-z1))] + | _ -> [] + end + | _,_ -> [] + end + | UnOp (LNot, e1, _) -> prop_of_cil ask e1 (not pos) + | _ -> [] +end + +module TMap = struct + include Map.Make(T) + let hash node_hash y = fold (fun x node acc -> acc + T.hash x + node_hash node) y 0 +end + +module TSet = struct + include Set.Make(T) + let hash x = fold (fun x y -> y + T.hash x) x 0 +end + +(** Quantitative union find *) +module UnionFind = struct + module ValMap = TMap + + (** (value * offset) ref * size of equivalence class *) + type 'v node = ('v * Z.t) * int [@@deriving eq, ord, hash] + + type t = T.t node ValMap.t [@@deriving eq, ord, hash] (** Union Find Map: maps value to a node type *) + + exception UnknownValue of T.t + exception InvalidUnionFind of string + + let empty = ValMap.empty + + (** create empty union find map, given a list of elements *) + let init = List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) + + (** `parent uf v` returns (p, z) where p is the parent element of + v in the union find tree and z is the offset. + + Throws "Unknown value" if v is not present in the data structure.*) + let parent uf v = match fst (ValMap.find v uf) with + | exception Not_found -> raise (UnknownValue v) + | x -> x + + (** `parent_opt uf v` returns Some (p, z) where p is the parent element of + v in the union find tree and z is the offset. + It returns None if v is not present in the data structure. *) + let parent_opt uf v = Option.map (fun _ -> parent uf v) (ValMap.find_opt v uf) + + let parent_term uf v = fst (parent uf v) + let parent_offset uf v = snd (parent uf v) + let subtree_size uf v = snd (ValMap.find v uf) + + (** Modifies the size of the equivalence class for the current element and + for the whole path to the root of this element. + + The third parameter `modification` is the function to apply to the sizes. *) + let rec modify_size t uf modification = + let (p, old_size) = ValMap.find t uf in + let uf = ValMap.add t (p, modification old_size) uf in + let parent = fst p in + if T.equal parent t then uf else modify_size parent uf modification + + let modify_parent uf v (t, offset) = + let (_, size) = ValMap.find v uf in + ValMap.add v ((t, offset), size) uf + + let modify_offset uf v modification = + let ((t, offset), size) = ValMap.find v uf in + ValMap.add v ((t, modification offset), size) uf + + (** Returns true if each equivalence class in the data structure contains only one element, + i.e. every node is a root. *) + let is_empty uf = List.for_all (fun (v, (t, _)) -> T.equal v (fst t)) (ValMap.bindings uf) + + (** Returns true if v is the representative value of its equivalence class. + + Throws "Unknown value" if v is not present in the data structure. *) + let is_root uf v = let (parent_t, _) = parent uf v in T.equal v parent_t + + (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements + grouped by equivalence classes, while this function just prints them in any order. + + Throws "Unknown value" if v is not present in the data structure. *) + let show_uf_ugly uf = + List.fold_left (fun s (v, (refv, size)) -> + s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ T.show v ^ + "; Parent: " ^ T.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") + "" (ValMap.bindings uf) ^ "\n" + + (** + For a variable t it returns the reference variable v and the offset r. + This find performs path compression. + It returns als the updated union-find tree after the path compression. + + Throws "Unknown value" if t is not present in the data structure. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. + *) + let find uf v = + let (v',r') = parent uf v in + if T.equal v' v then + (* v is a root *) + if Z.equal r' Z.zero then v',r', uf + else raise (InvalidUnionFind "non-zero self-distance!") + else if is_root uf v' then + (* the parent of v is a root *) + v',r', uf + else + let rec search v list = + let (v',r') = parent uf v in + if is_root uf v' then + (* perform path compresion *) + let (r',uf) = List.fold_left (fun (r0, uf) v -> + let (parent_v, r''), size_v = ValMap.find v uf in + let uf = modify_parent uf v (v',Z.(r0+r'')) in + let uf = modify_size parent_v uf (fun s -> s - size_v) in + let uf = modify_size v' uf ((+) size_v) + in Z.(r0+r''),uf) (Z.zero, uf) (v::list) + in v',r',uf + else search v' (v :: list) + in search v' [v] + + (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) + let find_opt uf v = match find uf v with + | exception (UnknownValue _) + | exception Not_found + | exception (InvalidUnionFind _) -> None + | res -> Some res + + (** + For a variable t it returns the reference variable v and the offset r. + This find DOES NOT perform path compression. + + Throws "Unknown value" if t is not present in the data structure. + Throws "Invalid Union Find" if it finds an element in the data structure that is a root but it has a non-zero distance to itself. + *) + let rec find_no_pc uf v = + let (v',r') = parent uf v in + if T.equal v' v then + if Z.equal r' Z.zero then (v',r') + else raise (InvalidUnionFind "non-zero self-distance!") + else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) + + (** Returns find of v if v is in the union find data structure. + Otherwise it just returns v. *) + let find_no_pc_if_possible uf v = + match find_no_pc uf v with + | exception (UnknownValue _) + | exception Not_found + | exception (InvalidUnionFind _) -> v, Z.zero + | res -> res + + let compare_repr = Tuple2.compare ~cmp1:T.compare ~cmp2:Z.compare + + (** Compare only first element of the tuples (= the parent term). + It ignores the offset. *) + let compare_repr_v (v1, _) (v2, _) = T.compare v1 v2 + + (** + Parameters: uf v1 v2 r + + changes the union find data structure `uf` such that the equivalence classes of `v1` and `v2` are merged and `v1 = v2 + r` + + returns v,uf,b where + + - `v` is the new reference term of the merged equivalence class. It is either the old reference term of v1 or of v2, depending on which equivalence class is bigger. + + - `uf` is the new union find data structure + + - `b` is true iff v = find v1 + + *) + let union uf v'1 v'2 r = + let v1,r1,uf = find uf v'1 in + let v2,r2,uf = find uf v'2 in + if T.equal v1 v2 then + if Z.(equal r1 (r2 + r)) then v1, uf, true + else raise (Failure "incomparable union") + else let (_,s1), (_,s2) = ValMap.find v1 uf, ValMap.find v2 uf in + if s1 <= s2 then ( + v2, modify_size v2 (modify_parent uf v1 (v2, Z.(r2 - r1 + r))) ((+) s1), false + ) else ( + v1, modify_size v1 (modify_parent uf v2 (v1, Z.(r1 - r2 - r))) ((+) s2), true + ) + + (** Returns a list of equivalence classes. *) + let get_eq_classes uf = List.group (fun (el1,_) (el2,_) -> compare_repr_v (find_no_pc uf el1) (find_no_pc uf el2)) (ValMap.bindings uf) + + (** Throws "Unknown value" if the data structure is invalid. *) + let show_uf uf = List.fold_left (fun s eq_class -> + s ^ List.fold_left (fun s (v, (t, size)) -> + s ^ "\t" ^ (if is_root uf v then "R: " else "") ^ "("^T.show v ^ "; P: " ^ T.show (fst t) ^ + "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class + ^ "----\n") "" (get_eq_classes uf) ^ "\n" + + let get_representatives uf = + List.filter_map (fun (el,_) -> if is_root uf el then Some el else None) (TMap.bindings uf) +end + +module ZMap = struct + include Map.Make(Z) + let hash hash_f y = fold (fun x node acc -> acc + Z.hash x + hash_f node) y 0 +end + +(** For each representative t' of an equivalence class, the LookupMap maps t' to a map that maps z to a term in the data structure that is equal to *(z + t').*) +module LookupMap = struct + (* map: term -> z -> *(z + t) *) + type t = T.t ZMap.t TMap.t [@@deriving eq, ord, hash] + + let bindings = TMap.bindings + let add = TMap.add + let remove = TMap.remove + let empty = TMap.empty + let find_opt = TMap.find_opt + let find = TMap.find + + let zmap_bindings = ZMap.bindings + let zmap_find_opt = ZMap.find_opt + let zmap_add = ZMap.add + + (** Returns the element to which (v, r) is mapped, or None if (v, r) is mapped to nothing. *) + let map_find_opt (v,r) (map:t) = match find_opt v map with + | None -> None + | Some zmap -> (match zmap_find_opt r zmap with + | None -> None + | Some v -> Some v + ) + + let map_add (v,r) v' (map:t) = match find_opt v map with + | None -> add v (zmap_add r v' ZMap.empty) map + | Some zmap -> add v (zmap_add r v' zmap) map + + let show_map (map:t) = + List.fold_left + (fun s (v, zmap) -> + s ^ T.show v ^ "\t:\n" ^ + List.fold_left + (fun s (r, v) -> + s ^ "\t" ^ Z.to_string r ^ ": " ^ T.show v ^ "; ") + "" (zmap_bindings zmap) ^ "\n") + "" (bindings map) + + (** The value at v' is shifted by r and then added for v. + The old entry for v' is removed. *) + let shift v r v' map = + match find_opt v' map with + | None -> map + | Some zmap -> let infl = zmap_bindings zmap in + let zmap = List.fold_left (fun zmap (r', v') -> + zmap_add Z.(r' + r) v' zmap) ZMap.empty infl in + remove v' (add v zmap map) + + (** Find all outgoing edges of v in the automata.*) + let successors v (map:t) = + match find_opt v map with + | None -> [] + | Some zmap -> zmap_bindings zmap + + (** Filters elements from the mapped values which fulfil the predicate p. *) + let filter_if (map:t) p = + TMap.filter_map (fun _ zmap -> + let zmap = ZMap.filter (fun key value -> p value) zmap + in if ZMap.is_empty zmap then None else Some zmap) map + + (** Maps elements from the mapped values by applying the function f to them. *) + let map_values (map:t) f = + TMap.map (fun zmap -> + ZMap.map f zmap) map +end diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index ca1a9c9388..41aeb05a04 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -275,6 +275,7 @@ module RegionDomain = RegionDomain module StackDomain = StackDomain module CongruenceClosure = CongruenceClosure +module UnionFind = UnionFind module WeaklyRelationalPointerDomain = WeaklyRelationalPointerDomain (** {2 Testing} From 1ed0bd542afb4da010d2b8a1f7274cb6e1e88837 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 17:15:33 +0200 Subject: [PATCH 202/323] copy the whole wrpointer analysis and give it another name --- src/analyses/c2poAnalysis.ml | 222 ++++++ src/cdomains/c2poDomain.ml | 1360 ++++++++++++++++++++++++++++++++++ src/goblint_lib.ml | 2 + 3 files changed, 1584 insertions(+) create mode 100644 src/analyses/c2poAnalysis.ml create mode 100644 src/cdomains/c2poDomain.ml diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml new file mode 100644 index 0000000000..d8f0950cd6 --- /dev/null +++ b/src/analyses/c2poAnalysis.ml @@ -0,0 +1,222 @@ +(** A 2-pointer analysis for C. I made this in a few days so please don't judge the code quality. ([2cpo])*) + +open Analyses +open GoblintCil +open C2poDomain +module CC = CongruenceClosure +open CC +open Batteries + +module Spec = +struct + include DefaultSpec + include Analyses.IdentitySpec + module D = D + module C = D + + let name () = "c2po" + let startcontext () = D.empty () + + (* find reachable variables in a function *) + let reachable_from_args ctx args = + let res = + List.fold (fun vs e -> vs @ (ctx.ask (ReachableFrom e) |> Queries.AD.to_var_may)) [] args in + if M.tracing then M.tracel "wrpointer-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res + + (* Returns Some true if we know for sure that it is true, + and Some false if we know for sure that it is false, + and None if we don't know anyhing. *) + let eval_guard ask t e = + let prop_list = T.prop_of_cil ask e true in + let res = match split prop_list with + | [], [], [] -> None + | x::xs, _, [] -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None + | _, y::ys, [] -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None + | _ -> None (*there should never be block disequalities here...*) + in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" + d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res + + (* let query_may_point_to ctx t e = + if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" + d_exp e; + match T.of_cil (ask_of_ctx ctx) e with + | Some term, Some offset -> + begin match insert t term with + | _,None -> MayBeEqual.AD.top() + | _,Some cc -> + let res = let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + let equal_terms = List.filter valid_term comp in + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); + let intersect_query_result res (term,z) = + let next_query = + let ctx = {ctx with local=Some (init_cc [])} in + match MayBeEqual.ask_may_point_to (ask_of_ctx ctx) (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with + | exception (T.UnsupportedCilExpression _) -> MayBeEqual.AD.top() + | res -> if MayBeEqual.AD.is_bot res then MayBeEqual.AD.top() else res + in + MayBeEqual.AD.meet res next_query in + List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms + in if M.tracing then M.trace "wrpointer-query" "may-point-to %a : %a. Is bot: %b\n" + d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res + end + | _ -> + MayBeEqual.AD.top() *) + + let query ctx (type a) (q: a Queries.t): a Queries.result = + let open Queries in + match q with + | EvalInt e -> begin match eval_guard (ask_of_ctx ctx) ctx.local e with + | None -> Result.top q + | Some res -> + let ik = Cilfacade.get_ikind_exp e in + ID.of_bool ik res + end + (* TODO Invariant. + | Queries.Invariant context -> get_normal_form context*) + (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) + | _ -> Result.top q + + let assign_lval t ask lval expr = + (* ignore assignments to values that are not 64 bits *) (*TODO what if there is a cast*) + let lval_t = typeOfLval lval in + match T.get_element_size_in_bits lval_t, T.of_lval ask lval, T.of_cil ask expr with + (* Indefinite assignment *) + | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t + (* Definite assignment *) + | s, lterm, (Some term, Some offset) -> + let dummy_var = MayBeEqual.dummy_var lval_t in + if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); + t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> + D.remove_may_equal_terms ask s lterm |> + meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> + D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo lval_t + | exception (T.UnsupportedCilExpression _) -> D.top () + (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. + We have to forget all the information we had. + This should almost never happen. + Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) + | _ -> D.top () + + let assign ctx lval expr = + let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in + if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res + + let branch ctx e pos = + let props = T.prop_of_cil (ask_of_ctx ctx) e pos in + let valid_props = T.filter_valid_pointers props in + let res = meet_conjs_opt valid_props ctx.local in + if D.is_bot res then raise Deadcode; + if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" + d_exp e pos (show_conj valid_props); + res + + let body ctx f = ctx.local (*DONE*) + + let assign_return ask t return_var expr = + (* the return value is not stored on the heap, therefore we don't need to remove any terms *) + match T.of_cil ask expr with + | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] t + | _ -> t + + let return ctx exp_opt f = + let res = match exp_opt with + | Some e -> + assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e + | None -> ctx.local + in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res + + + let add_new_block t ask lval = + (* ignore assignments to values that are not 64 bits *) + let lval_t = typeOfLval lval in + match T.get_element_size_in_bits lval_t, T.of_lval ask lval with + (* Indefinite assignment *) + | s, lterm -> + (* let t = D.remove_may_equal_terms ask s lterm t in + -> not necessary because this is always a new fresh variable in goblint *) + add_block_diseqs t lterm + (* Definite assignment *) + | exception (T.UnsupportedCilExpression _) -> D.top () + + (** var_opt is the variable we assign to. It has type lval. v=malloc.*) + let special ctx var_opt v exprs = + let desc = LibraryFunctions.find v in + match desc.special exprs with + | Assert { exp; refine; _ } -> if not refine then + ctx.local + else + branch ctx exp true + | Malloc exp -> (*exp is the size of the malloc'ed block*) + begin match var_opt with + | None -> + ctx.local + | Some varin -> + if M.tracing then M.trace "wrpointer-malloc" + "SPECIAL MALLOC: exp = %a; var_opt = Some (%a); v = %a; " d_exp exp d_lval varin d_lval (Var v, NoOffset); + add_new_block ctx.local (ask_of_ctx ctx) varin + end + | _ -> ctx.local + + let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } + let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } + + (*First all local variables of the function are duplicated (by negating their ID), + then we remember the value of each local variable at the beginning of the function + by using the analysis startState. This way we can infer the relations between the + local variables of the caller and the pointers that were modified by the function. *) + let enter ctx var_opt f args = + (* add duplicated variables, and set them equal to the original variables *) + let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in + let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in + if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + (* remove callee vars that are not reachable and not global *) + let reachable_variables = + f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args + in + let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in + if M.tracing then M.trace "wrpointer-function" "ENTER2: result: %s\n" (D.show new_state); + [ctx.local, new_state] + + (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t + expr funktionsaufruf*) + let combine_env ctx var_opt expr f exprs t_context_opt t (ask: Queries.ask) = + ctx.local + + (*ctx.local is after combine_env, t callee*) + let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = + let og_t = t in + (* assign function parameters to duplicated values *) + let arg_assigns = GobList.combine_short f.sformals args in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); + (*remove all variables that were tainted by the function*) + let tainted = (* find out the tainted variables from startState *) + ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) + in + if M.tracing then M.trace "wrpointer-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; + let local = D.remove_tainted_terms ask tainted state_with_assignments in + let t = D.meet local t in + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + let t = match var_opt with + | None -> t + | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) + in + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); + let local_vars = f.sformals @ f.slocals in + let duplicated_vars = List.map duplicated_variable f.sformals in + let t = + D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t + in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t + + let startstate v = D.top () + let threadenter ctx ~multiple lval f args = [D.top ()] + let threadspawn ctx ~multiple lval f args fctx = D.top() + let exitstate v = D.top () + +end + +let _ = + MCP.register_analysis ~dep:["startState"; "taintPartialContexts"] (module Spec : MCPSpec) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml new file mode 100644 index 0000000000..35d28de43e --- /dev/null +++ b/src/cdomains/c2poDomain.ml @@ -0,0 +1,1360 @@ +(** It's the same as wrpointer but less precise and hopefully more efficient? *) +include UnionFind +open Batteries +open GoblintCil +module Var = CilType.Varinfo +module M = Messages + +(** Quantitative congruence closure on terms *) +module CongruenceClosure = struct + + module TUF = UnionFind + module LMap = LookupMap + + module Disequalities = struct + + (* disequality map: + if t_1 -> z -> {t_2, t_3} + then we know that t_1 + z != t_2 + and also that t_1 + z != t_3 + *) + type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) + type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) + + let empty = TMap.empty + let remove = TMap.remove + (** Returns a list of tuples, which each represent a disequality *) + let bindings = + List.flatten % + List.concat_map + (fun (t, smap) -> + List.map (fun (z, tset) -> + List.map (fun term -> + (t,z,term)) (TSet.elements tset)) + (ZMap.bindings smap) + ) % TMap.bindings + + let bindings_args = + List.flatten % + List.concat_map + (fun (t, smap) -> + List.map (fun (z, arglist) -> + List.map (fun (a,b) -> + (t,z,a,b)) arglist) + (ZMap.bindings smap) + ) % TMap.bindings + + (** adds a mapping v -> r -> size -> { v' } to the map, + or if there are already elements + in v -> r -> {..} then v' is added to the previous set *) + let map_set_add (v,r) v' (map:t) = match TMap.find_opt v map with + | None -> TMap.add v (ZMap.add r (TSet.singleton v') ZMap.empty) map + | Some imap -> TMap.add v ( + match ZMap.find_opt r imap with + | None -> ZMap.add r (TSet.singleton v') imap + | Some set -> ZMap.add r (TSet.add v' set) imap) map + + let shift = LMap.shift + + let map_set_mem (v,r) v' (map:t) = match TMap.find_opt v map with + | None -> false + | Some imap -> (match ZMap.find_opt r imap with + | None -> false + | Some set -> TSet.mem v' set + ) + + (** Map of partition, transform union find to a map + of type V -> Z -> V set + with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) + let comp_map uf = List.fold_left (fun comp (v,_) -> + map_set_add (TUF.find_no_pc uf v) v comp) + TMap.empty (TMap.bindings uf) + + (** Find all elements that are in the same equivalence class as t. *) + let comp_t uf t = + let (t',z') = TUF.find_no_pc uf t in + List.fold_left (fun comp (v,((p,z),_)) -> + let (v', z'') = TUF.find_no_pc uf v in + if T.equal v' t' then (v, Z.(z'-z''))::comp else comp + ) + [] (TMap.bindings uf) + + let flatten_map = + ZMap.map (fun zmap -> List.fold_left + (fun set (_,mapped) -> TSet.union set mapped) TSet.empty (ZMap.bindings zmap)) + + (** arg: + + maps each representative term t to a map that maps an integer Z to + a list of representatives t' of v where *(v + z') is + in the representative class of t. + + It basically maps each state in the automata to its predecessors. *) + let get_args uf = + let cmap = comp_map uf in + let clist = TMap.bindings cmap in + let arg = List.fold_left (fun arg (v, imap) -> + let ilist = ZMap.bindings imap in + let iarg = List.fold_left (fun iarg (r,set) -> + let list = List.filter_map (function + | Deref (v', r', _) -> + let (v0,r0) = TUF.find_no_pc uf v' in + Some (v0,Z.(r0+r')) + | _ -> None) (TSet.elements set) in + ZMap.add r list iarg) ZMap.empty ilist in + TMap.add v iarg arg) TMap.empty clist in + (uf,cmap,arg) + + let fold_left2 f acc l1 l2 = + List.fold_left ( + fun acc x -> List.fold_left ( + fun acc y -> f acc x y) acc l2) acc l1 + + let map2 f l1 l2 = List.concat_map (fun x -> + List.map (fun y -> f x y) l2) l1 + + let map_find_opt (v,r) map = match TMap.find_opt v map with + | None -> None + | Some imap -> (match ZMap.find_opt r imap with + | None -> None + | Some v -> Some v + ) + + let map_find_all t map = + match TMap.find_opt t map with + | None -> [] + | Some imap -> List.fold (fun list (z,list2) -> + list@list2 + ) [] (ZMap.bindings imap) + + let check_neq (_,arg) rest (v,zmap) = + let zlist = ZMap.bindings zmap in + fold_left2 (fun rest (r1,_) (r2,_) -> + if Z.equal r1 r2 then rest + else (* r1 <> r2 *) + let l1 = match map_find_opt (v,r1) arg + with None -> [] + | Some list -> list in + (* just take the elements of set1 ? *) + let l2 = match map_find_opt (v,r2) arg + with None -> [] + | Some list -> list in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if T.equal v1 v2 then if Z.equal r'1 r'2 + then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 + ) rest zlist zlist + + let check_neq_bl (uf,arg) rest (t1, tset) = + List.fold (fun rest t2 -> + if T.equal (fst@@TUF.find_no_pc_if_possible uf t1) (fst@@TUF.find_no_pc_if_possible uf t2) + then raise Unsat + else (* r1 <> r2 *) + let l1 = map_find_all t1 arg in + let l2 = map_find_all t2 arg in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if T.equal v1 v2 then if Z.equal r'1 r'2 + then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 + ) rest (TSet.to_list tset) + + (** Initialize the list of disequalities taking only implicit dis-equalities into account. + + Returns: List of non-trivially implied dis-equalities *) + let init_neq (uf,cmap,arg) = + List.fold_left (check_neq (uf,arg)) [] (TMap.bindings cmap) + + let init_neg_block_diseq (uf, bldis, cmap, arg) = + List.fold_left (check_neq_bl (uf,arg)) [] (TMap.bindings bldis) + + (** Initialize the list of disequalities taking explicit dis-equalities into account. + + Parameters: union-find partition, explicit disequalities.battrs + + Returns: list of normalized provided dis-equalities *) + let init_list_neq uf neg = + List.filter_map (fun (v1,v2,r) -> + let (v1,r1) = TUF.find_no_pc uf v1 in + let (v2,r2) = TUF.find_no_pc uf v2 in + if T.equal v1 v2 then if Z.(equal r1 (r2+r)) then raise Unsat + else None + else Some (v1,v2,Z.(r2-r1+r))) neg + + (** Parameter: list of disequalities (t1, t2, z), where t1 and t2 are roots. + + Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. + *) + let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) + | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) + | (v1,v2,r) :: rest -> + (* we don't want to explicitly store disequalities of the kind &x != &y *) + if T.is_addr v1 && T.is_addr v2 then + propagate_neq (uf,cmap,arg,neq) rest else + (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) + if T.equal v1 v2 then (* should not happen *) + if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) rest + else (* check whether it is already in neq *) + if map_set_mem (v1,Z.(-r)) v2 neq then propagate_neq (uf,cmap,arg,neq) rest + else let neq = map_set_add (v1,Z.(-r)) v2 neq |> + map_set_add (v2,r) v1 in + (* + search components of v1, v2 for elements at distance r to obtain inferred equalities + at the same level (not recorded) and then compare their predecessors + *) + match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with + | None,_ | _,None -> (*should not happen*) propagate_neq (uf,cmap,arg,neq) rest + | Some imap1, Some imap2 -> + let ilist1 = ZMap.bindings imap1 in + let rest = List.fold_left (fun rest (r1,_) -> + match ZMap.find_opt Z.(r1+r) imap2 with + | None -> rest + | Some _ -> + let l1 = match map_find_opt (v1,r1) arg + with None -> [] + | Some list -> list in + let l2 = match map_find_opt (v2,Z.(r1+r)) arg + with None -> [] + | Some list -> list in + fold_left2 (fun rest (v1',r'1) (v2',r'2) -> + if T.equal v1' v2' then if Z.equal r'1 r'2 then raise Unsat + else rest + else + (v1',v2',Z.(r'2-r'1))::rest ) rest l1 l2) + rest ilist1 in + propagate_neq (uf,cmap,arg,neq) rest + (* + collection of disequalities: + * disequalities originating from different offsets of same root + * stated disequalities + * closure by collecting appropriate args + for a disequality v1 != v2 +r for distinct roots v1,v2 + check whether there is some r1, r2 such that r1 = r2 +r + then dis-equate the sets at v1,r1 with v2,r2. + *) + + let show_neq neq = + let clist = bindings neq in + List.fold_left (fun s (v,r,v') -> + s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " + ^ T.show v' ^ "\n") "" clist + + let show_cmap neq = + let clist = bindings neq in + List.fold_left (fun s (v,r,v') -> + s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " = " + ^ T.show v' ^ "\n") "" clist + + let show_arg arg = + let clist = bindings_args arg in + List.fold_left (fun s (v,z,v',r) -> + s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " --> " + ^ T.show v^ "+"^ Z.to_string z ^ "\n") "" clist + + let filter_if map p = + TMap.filter_map (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ t_set -> let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) zmap + in if ZMap.is_empty zmap then None else Some zmap) map + + let filter_map f (diseq:t) = + TMap.filter_map + (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) + zmap in if ZMap.is_empty zmap then None else Some zmap) diseq + + let get_disequalities = List.map + (fun (t1, z, t2) -> + Nequal (t1,t2,Z.(-z)) + ) % bindings + + let element_closure diseqs cmap = + let comp_closure (r1,r2,z) = + let to_tuple_list = (*TODO this is not the best solution*) + List.flatten % List.map + (fun (z, set) -> List.cartesian_product [z] (TSet.to_list set)) in + let comp_closure_zmap bindings1 bindings2 = + List.map (fun ((z1, nt1),(z2, nt2)) -> + (nt1, nt2, Z.(-z2+z+z1))) + (List.cartesian_product (to_tuple_list bindings1) (to_tuple_list bindings2)) + in + let singleton term = [Z.zero, TSet.singleton term] in + begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with + | None, None -> [(r1,r2,z)] + | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) + | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) + | Some zmap1, Some zmap2 -> + comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) + end + in + List.concat_map comp_closure diseqs + end + + (* block disequalities *) + module BlDis = struct + type t = TSet.t TMap.t [@@deriving eq, ord, hash] (* block disequalitites *) + + let bindings = TMap.bindings + let empty = TMap.empty + + let to_conj bldiseq = List.fold + (fun list (t1, tset) -> + TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list + ) [] (bindings bldiseq) + + let add bldiseq t1 t2 = + match TMap.find_opt t1 bldiseq with + | None -> TMap.add t1 (TSet.singleton t2) bldiseq + | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq + + let add_block_diseq bldiseq (t1, t2) = + add (add bldiseq t1 t2) t2 t1 + + (** + params: + + t1-> any term + + tlist: a list of representative terms + + For each term t2 in tlist, it adds the disequality t1' != t2 to diseqs + where t1' is the representative of t1. + Except the block disequality t1' = t1' will not be added, even + if t1' is in tlist. + *) + let add_block_diseqs bldiseq uf t1 tlist = + let t1',_ = t1, t1 in + (* TODO: not a good idea: TUF.find_no_pc uf t1 in *) + List.fold (fun bldiseq t2 -> + if T.equal t1' t2 then bldiseq + else add_block_diseq bldiseq (t1', t2)) bldiseq tlist + + let element_closure bldis cmap = + let comp_closure = function + | BlNequal (r1,r2) -> + let to_list = (*TODO this is not the best solution*) + List.flatten % List.map + (fun (z, set) -> (TSet.to_list set)) in + let comp_closure_zmap bindings1 bindings2 = + List.cartesian_product (to_list bindings1) (to_list bindings2) + in + let singleton term = [(Z.zero, TSet.singleton term)] in + begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with + | None, None -> [(r1,r2)] + | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) + | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) + | Some zmap1, Some zmap2 -> + comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) + end + | _ -> [] + in + List.concat_map comp_closure bldis + + let map_set_mem v v' (map:t) = match TMap.find_opt v map with + | None -> false + | Some set -> TSet.mem v' set + end + + (** Set of subterms which are present in the current data structure. *) + module SSet = struct + type t = TSet.t [@@deriving eq, ord, hash] + + let elements = TSet.elements + let mem = TSet.mem + let add = TSet.add + let fold = TSet.fold + let empty = TSet.empty + let to_list = TSet.to_list + let inter = TSet.inter + let find_opt = TSet.find_opt + let union = TSet.union + + let show_set set = TSet.fold (fun v s -> + s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" + + (** Adds all subterms of t to the SSet and the LookupMap*) + let rec subterms_of_term (set,map) t = match t with + | Addr _ | Aux _ -> (add t set, map) + | Deref (t',z,_) -> + let set = add t set in + let map = LMap.map_add (t',z) t map in + subterms_of_term (set, map) t' + + (** Adds all subterms of the proposition to the SSet and the LookupMap*) + let subterms_of_prop (set,map) = function + | (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 + + let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list + + let fold_atoms f (acc:'a) set:'a = + let exception AtomsDone in + let res = ref acc in + try + TSet.fold (fun (v:T.t) acc -> match v with + | Addr _| Aux _ -> f acc v + | _ -> res := acc; raise AtomsDone) set acc + with AtomsDone -> !res + + let get_atoms set = + (* `elements set` returns a sorted list of the elements. The atoms are always smaller that other terms, + according to our comparison function. Therefore take_while is enough. *) + BatList.take_while (function Addr _ | Aux _ -> true | _ -> false) (elements set) + + (** We try to find the dereferenced term between the already existing terms, in order to remember the information about the exp. *) + let deref_term t z set = + let exp = T.to_cil t in + match find_opt (Deref (t, z, exp)) set with + | None -> Deref (t, z, T.dereference_exp exp z) + | Some t -> t + + let deref_term_even_if_its_not_possible min_term z set = + match deref_term min_term z set with + | result -> result + | exception (T.UnsupportedCilExpression _) -> + let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr and get_normal_form*) + Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z (Some random_type), random_type)), NoOffset)) + + end + + (** Minimal representatives map. + It maps each representative term of an equivalence class to the minimal term of this representative class. + rep -> (t, z) means that t = rep + z *) + module MRMap = struct + type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] + + let bindings = TMap.bindings + let find = TMap.find + let find_opt = TMap.find_opt + let add = TMap.add + let remove = TMap.remove + let mem = TMap.mem + let empty = TMap.empty + + let show_min_rep min_representatives = + let show_one_rep s (state, (rep, z)) = + s ^ "\tState: " ^ T.show state ^ + "\n\tMin: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")--\n\n" + in + List.fold_left show_one_rep "" (bindings min_representatives) + + let rec update_min_repr (uf, set, map) min_representatives = function + | [] -> min_representatives, uf + | state::queue -> (* process all outgoing edges in order of ascending edge labels *) + match LMap.successors state map with + | edges -> + let process_edge (min_representatives, queue, uf) (edge_z, next_term) = + let next_state, next_z, uf = TUF.find uf next_term in + let (min_term, min_z) = find state min_representatives in + let next_min = + (SSet.deref_term_even_if_its_not_possible min_term Z.(edge_z - min_z) set, next_z) in + match TMap.find_opt next_state min_representatives + with + | None -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | _ -> (min_representatives, queue, uf) + in + let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges + in update_min_repr (uf, set, map) min_representatives queue + + (** Uses dijkstra algorithm to update the minimal representatives of + the successor nodes of all edges in the queue + and if necessary it recursively updates the minimal representatives of the successor nodes. + The states in the queue must already have an updated min_repr. + This function visits only the successor nodes of the nodes in queue, not the nodes themselves. + Before visiting the nodes, it sorts the queue by the size of the current mininmal representative. + + parameters: + + - `(uf, map)` represent the union find data structure and the corresponding lookup map. + - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. + - `queue` contains the states that need to be processed. + The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. + Therefore the queue is a list of representative terms. + + Returns: + - The map with the minimal representatives + - The union find tree. This might have changed because of path compression. *) + let update_min_repr (uf, set, map) min_representatives queue = + (* order queue by size of the current min representative *) + let queue = + List.sort_unique (fun el1 el2 -> let compare_repr = TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives) in + if compare_repr = 0 then T.compare el1 el2 else compare_repr) (List.filter (TUF.is_root uf) queue) + in update_min_repr (uf, set, map) min_representatives queue + + (** + Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. + It's used for now when removing elements, then the min_repr map gets recomputed. + + Returns: + - The map with the minimal representatives + - The union find tree. This might have changed because of path compression. *) + let compute_minimal_representatives (uf, set, map) = + if M.tracing then M.trace "wrpointer" "compute_minimal_representatives\n"; + let atoms = SSet.get_atoms set in + (* process all atoms in increasing order *) + let uf_ref = ref uf in + let atoms = + List.sort (fun el1 el2 -> + let v1, z1, new_uf = TUF.find !uf_ref el1 in + uf_ref := new_uf; + let v2, z2, new_uf = TUF.find !uf_ref el2 in + uf_ref := new_uf; + let repr_compare = TUF.compare_repr (v1, z1) (v2, z2) + in + if repr_compare = 0 then T.compare el1 el2 else repr_compare) atoms in + let add_atom_to_map (min_representatives, queue, uf) a = + let (rep, offs, uf) = TUF.find uf a in + if not (mem rep min_representatives) then + (add rep (a, offs) min_representatives, queue @ [rep], uf) + else (min_representatives, queue, uf) + in + let (min_representatives, queue, uf) = List.fold_left add_atom_to_map (empty, [], uf) atoms + (* compute the minimal representative of all remaining edges *) + in update_min_repr (uf, set, map) min_representatives queue + + (** Computes the initial map of minimal representatives. + It maps each element `e` in the set to `(e, 0)`. *) + let initial_minimal_representatives set = + List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) + end + + type t = {uf: TUF.t; + set: SSet.t; + map: LMap.t; + min_repr: MRMap.t; + diseq: Disequalities.t; + bldis: BlDis.t} + [@@deriving eq, ord, hash] + + let string_of_prop = function + | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 + | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 + | Nequal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 + | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 + | BlNequal (t1,t2) -> "bl(" ^ T.show t1 ^ ") != bl(" ^ T.show t2 ^ ")" + + let show_conj list = List.fold_left + (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list + + (** Returns a list of all the transition that are present in the automata. *) + let get_transitions (uf, map) = + List.concat_map (fun (t, zmap) -> + (List.map (fun (edge_z, res_t) -> + (edge_z, t, TUF.find_no_pc uf res_t)) @@ + (LMap.zmap_bindings zmap))) + (LMap.bindings map) + + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) + Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) + (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) + let get_normal_form cc = + let normalize_equality (t1, t2, z) = + if T.equal t1 t2 && Z.(equal z zero) then None else + Some (Equal (t1, t2, z)) in + let conjunctions_of_atoms = + let atoms = SSet.get_atoms cc.set in + List.filter_map (fun atom -> + let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in + let (min_state, min_z) = MRMap.find rep_state cc.min_repr in + normalize_equality (atom, min_state, Z.(rep_z - min_z)) + ) atoms + in + let conjunctions_of_transitions = + let transitions = get_transitions (cc.uf, cc.map) in + List.filter_map (fun (z,s,(s',z')) -> + let (min_state, min_z) = MRMap.find s cc.min_repr in + let (min_state', min_z') = MRMap.find s' cc.min_repr in + normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) + ) transitions in + (*disequalities*) + let disequalities = Disequalities.get_disequalities cc.diseq in + (* find disequalities between min_repr *) + let normalize_disequality (t1, t2, z) = + let (min_state1, min_z1) = MRMap.find t1 cc.min_repr in + let (min_state2, min_z2) = MRMap.find t2 cc.min_repr in + let new_offset = Z.(-min_z2 + min_z1 + z) in + if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) + else Nequal (min_state2, min_state1, Z.(-new_offset)) + in + if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); + let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in + (* block disequalities *) + let normalize_bldis t = match t with + | BlNequal (t1,t2) -> + let min_state1 = + begin match MRMap.find_opt t1 cc.min_repr with + | None -> t1 + | Some (a,_) -> a + end in + let min_state2 = + begin match MRMap.find_opt t2 cc.min_repr with + | None -> t2 + | Some (a,_) -> a + end in + if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) + else BlNequal (min_state2, min_state1) + | _ -> t + in + let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in + (* all propositions *) + BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) + + let show_all x = "Normal form:\n" ^ + show_conj((get_normal_form x)) ^ + "Union Find partition:\n" ^ + (TUF.show_uf x.uf) + ^ "\nSubterm set:\n" + ^ (SSet.show_set x.set) + ^ "\nLookup map/transitions:\n" + ^ (LMap.show_map x.map) + ^ "\nMinimal representatives:\n" + ^ (MRMap.show_min_rep x.min_repr) + ^ "\nNeq:\n" + ^ (Disequalities.show_neq x.diseq) + ^ "\nBlock diseqs:\n" + ^ show_conj(BlDis.to_conj x.bldis) + + (** Splits the conjunction into two groups: the first one contains all equality propositions, + and the second one contains all inequality propositions. *) + let split conj = List.fold_left (fun (pos,neg,bld) -> function + | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg,bld) + | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg,bld) + | BlNequal (t1,t2) -> (pos,neg,(t1,t2)::bld)) ([],[],[]) conj + + (** + returns {uf, set, map, min_repr}, where: + + - `uf` = empty union find structure where the elements are all subterms occuring in the conjunction. + + - `set` = set of all subterms occuring in the conjunction. + + - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t'). + + - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. + *) + let init_cc conj = + let (set, map) = SSet.subterms_of_conj conj in + let uf = SSet.elements set |> + TUF.init in + let min_repr = MRMap.initial_minimal_representatives set in + {uf; set; map; min_repr; diseq = Disequalities.empty; bldis=BlDis.empty} + + (** closure of disequalities *) + let congruence_neq cc neg = + try + let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in + (* getting args of dereferences *) + let uf,cmap,arg = Disequalities.get_args cc.uf in + (* taking implicit dis-equalities into account *) + let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap,arg) in + let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) neq_list in + (* taking explicit dis-equalities into account *) + let neq_list = Disequalities.init_list_neq uf neg in + let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in + if M.tracing then M.trace "wrpointer-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); + Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=cc.bldis} + with Unsat -> None + + (** + parameters: (uf, map) equalities. + + returns updated (uf, map, queue), where: + + `uf` is the new union find data structure after having added all equalities. + + `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). + + `queue` is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. + It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map. + + `new_repr` -> maps each representative to its new representative after the union + + Throws "Unsat" if a contradiction is found. + *) + let rec closure (uf, map, min_repr, new_repr) queue = function + | [] -> (uf, map, queue, min_repr, new_repr) + | (t1, t2, r)::rest -> + (let v1, r1, uf = TUF.find uf t1 in + let v2, r2, uf = TUF.find uf t2 in + let sizet1, sizet2 = T.get_size t1, T.get_size t2 in + if not (Z.equal sizet1 sizet2) then + (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); + closure (uf, map, min_repr, new_repr) queue rest) else + if T.equal v1 v2 then + (* t1 and t2 are in the same equivalence class *) + if Z.equal r1 Z.(r2 + r) then closure (uf, map, min_repr, new_repr) queue rest + else raise Unsat + else let diff_r = Z.(r2 - r1 + r) in + let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) + (* update new_representative *) + let new_repr = if T.equal v v1 then TMap.add v2 v new_repr else TMap.add v1 v new_repr in + (* update map *) + let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with + | None, _, false -> map, rest + | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest + | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + (* we move all entries of imap2 to imap1 *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + let rest = match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (v', v'', Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) + (imap1,rest) infl2 in + LMap.remove v2 (LMap.add v zmap map), rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + let rest = + match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (v', v'',Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in + LMap.remove v1 (LMap.add v zmap map), rest + in + (* update min_repr *) + let min_v1, min_v2 = MRMap.find v1 min_repr, MRMap.find v2 min_repr in + (* 'changed' is true if the new_min is different than the old min *) + let new_min, changed = if T.compare (fst min_v1) (fst min_v2) < 0 then (min_v1, not b) else (min_v2, b) in + let new_min = (fst new_min, if b then Z.(snd new_min - diff_r) else Z.(snd new_min + diff_r)) in + let removed_v = if b then v2 else v1 in + let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in + let queue = v :: queue in + closure (uf, map, min_repr, new_repr) queue rest + ) + + let update_bldis new_repr bldis = + (* update block disequalities with the new representatives *) + let find_new_root t1 = match TMap.find_opt t1 new_repr with + | None -> t1 + | Some v -> v + in + let disequalities = BlDis.to_conj bldis + in (*TODO maybe optimize?, and maybe use this also for removing terms *) + let add_bl_dis new_diseq = function + | BlNequal (t1,t2) ->BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) + | _-> new_diseq + in + List.fold add_bl_dis BlDis.empty disequalities + + let rec add_normalized_bl_diseqs cc = function + | [] -> cc + | (t1,t2)::bl_conjs -> + match cc with + | None -> None + | Some cc -> + let t1' = fst (TUF.find_no_pc cc.uf t1) in + let t2' = fst (TUF.find_no_pc cc.uf t2) in + if T.equal t1' t2' then None (*unsatisfiable*) + else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in + add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs + + let closure_no_min_repr cc conjs = + match cc with + | None -> None + | Some cc -> + let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in + let bldis = update_bldis new_repr cc.bldis in + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] + + (** + Parameters: cc conjunctions. + + returns updated cc, where: + + - `uf` is the new union find data structure after having added all equalities. + + - `set` doesn't change + + - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). + + - `min_repr` maps each equivalence class to its minimal representative. + + Throws "Unsat" if a contradiction is found. + *) + let closure cc conjs = + match cc with + | None -> None + | Some cc -> + let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in + let bldis = update_bldis new_repr cc.bldis in + (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) + let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in + if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); + congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] + + (** Throws Unsat if the congruence is unsatisfiable.*) + let init_congruence conj = + let cc = init_cc conj in + (* propagating equalities through derefs *) + closure (Some cc) conj + + (** Returns None if the congruence is unsatisfiable.*) + let init_congruence_opt conj = + let cc = init_cc conj in + (* propagating equalities through derefs *) + match closure (Some cc) conj with + | exception Unsat -> None + | x -> Some x + + (** Add a term to the data structure. + + Returns (reference variable, offset), updated (uf, set, map, min_repr), + and queue, that needs to be passed as a parameter to `update_min_repr`. + + `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. *) + let rec insert_no_min_repr cc t = + if SSet.mem t cc.set then + let v,z,uf = TUF.find cc.uf t in + (v,z), Some {cc with uf}, [] + else + match t with + | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in + let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in + let set = SSet.add t cc.set in + (t, Z.zero), Some {cc with uf; set; min_repr;}, [t] + | Deref (t', z, exp) -> + match insert_no_min_repr cc t' with + | (v, r), None, queue -> (v, r), None, [] + | (v, r), Some cc, queue -> + let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in + let set = SSet.add t cc.set in + match LMap.map_find_opt (v, Z.(r + z)) cc.map with + | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in + let uf = LMap.add t ((t, Z.zero),1) uf in + (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)], v::queue + | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in + let uf = LMap.add t ((t, Z.zero),1) cc.uf in + (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq; bldis=cc.bldis}, v::queue + + (** Add a term to the data structure. + + Returns (reference variable, offset), updated (uf, set, map, min_repr) *) + let insert cc t = + match cc with + | None -> (t, Z.zero), None + | Some cc -> + match insert_no_min_repr cc t with + | v, None, queue -> v, None + | v, Some cc, queue -> + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in + v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} + + (** Add all terms in a specific set to the data structure. + + Returns updated (uf, set, map, min_repr). *) + let insert_set cc t_set = + match SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = Option.map_default (fun cc -> insert_no_min_repr cc t) ((t, Z.zero), None, []) cc in (cc, queue @ a_queue) ) t_set (cc, []) with + | None, queue -> None + | Some cc, queue -> + (* update min_repr at the end for more efficiency *) + let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in + Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} + + (** Returns true if t1 and t2 are equivalent. *) + let rec eq_query cc (t1,t2,r) = + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + if T.equal v1 v2 && Z.equal r1 Z.(r2 + r) then (true, cc) + else + (* If the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, + i.e. if t1' + z1 = t2' + z2. + This is useful when the dereferenced elements are not pointers. *) + if Z.equal r Z.zero then + match t1,t2 with + | Deref (t1', z1, _), Deref (t2', z2, _) -> + eq_query cc (t1', t2', Z.(z2 - z1)) + | _ -> (false, cc) + else (false,cc) + + let eq_query_opt cc (t1,t2,r) = + match cc with + | None -> false + | Some cc -> fst (eq_query cc (t1,t2,r)) + + (*TODO there could be less code duplication *) + let block_neq_query cc (t1,t2) = + (* we implicitly assume that &x != &y + z *) + if T.is_addr t1 && T.is_addr t2 then true else + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + match cc with + | None -> true + | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis + + (** Returns true if t1 and t2 are not equivalent. *) + let neq_query cc (t1,t2,r) = + (* we implicitly assume that &x != &y + z *) + if T.is_addr t1 && T.is_addr t2 then true else + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + (* implicit disequalities following from equalities *) + if T.equal v1 v2 then + if Z.(equal r1 (r2 + r)) then false + else true + else + match cc with + | None -> true + | Some cc -> (* implicit disequalities following from block disequalities *) + BlDis.map_set_mem t1 t2 cc.bldis || + (*explicit dsequalities*) + Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq + + (** Adds equalities to the data structure. + Throws "Unsat" if a contradiction is found. *) + let meet_conjs cc pos_conjs = + let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in + closure cc pos_conjs + in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res + + let meet_conjs_opt conjs cc = + let pos_conjs, neg_conjs, bl_conjs = split conjs in + let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in + match insert_set (meet_conjs cc pos_conjs) terms_to_add with + | exception Unsat -> None + | Some cc -> let cc = congruence_neq cc neg_conjs in + add_normalized_bl_diseqs cc bl_conjs + | None -> None + + (** Add proposition t1 = t2 + r to the data structure. *) + let add_eq cc (t1, t2, r) = + let (v1, r1), cc = insert cc t1 in + let (v2, r2), cc = insert cc t2 in + let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in + cc + + (** adds block disequalities to cc: + fo each representative t in cc it adds the disequality bl(lterm)!=bl(t)*) + let add_block_diseqs cc lterm = + match cc with + | None -> cc + | Some cc -> + let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in + Some {cc with bldis} + + (* Remove variables: *) + + let remove_terms_from_eq predicate cc = + let rec insert_terms cc = + function | [] -> cc | t::ts -> insert_terms (Option.bind cc (fun cc -> Tuple3.second (insert_no_min_repr cc t))) ts in + (* start from all initial states that are still valid and find new representatives if necessary *) + (* new_reps maps each representative term to the new representative of the equivalence class *) + (*but new_reps contains an element but not necessarily the representative!!*) + let find_new_repr state old_rep old_z new_reps = + match LMap.find_opt old_rep new_reps with + | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps + | None -> if not @@ predicate old_rep then + old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) + (* the representative need to be removed from the data structure: state is the new repr.*) + state, Z.zero, TMap.add old_rep (state, old_z) new_reps in + let add_atom (new_reps, new_cc, reachable_old_reps) state = + let old_rep, old_z = TUF.find_no_pc cc.uf state in + let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in + let new_cc = insert_terms new_cc [state; new_rep] in + let new_cc = closure_no_min_repr new_cc [(state, new_rep, new_z)] in + (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) + in + let new_reps, new_cc, reachable_old_reps = + SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some(init_cc [])),[]) cc.set in + let cmap = Disequalities.comp_map cc.uf in + (* breadth-first search of reachable states *) + let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = + let old_rep_s, old_z_s = TUF.find_no_pc cc.uf s_t in + let find_successor_in_set (z, term_set) = + let exception Found in + let res = ref None in + try + TSet.iter (fun t -> + match SSet.deref_term t Z.(s_z-z) cc.set with + | exception (T.UnsupportedCilExpression _) -> () + | successor -> if (not @@ predicate successor) then + (res := Some successor; raise Found) + else + () + ) term_set; !res + with Found -> !res + in + (* find successor term -> find any element in equivalence class that can be dereferenced *) + match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with + | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then + let new_cc = insert_terms new_cc [successor_term] in + match LMap.find_opt old_rep_s new_reps with + | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) + new_reps, closure_no_min_repr new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps + | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. + -> we choose a successor term *(t+z) for any + -> we need add the successor state to the list of states that still need to be visited + *) + TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps + else + (new_reps, new_cc, reachable_old_reps) + | None -> + (* the term cannot be dereferenced, so we won't add this transition. *) + (new_reps, new_cc, reachable_old_reps) + in + (* find all successors that are still reachable *) + let rec add_transitions new_reps new_cc = function + | [] -> new_reps, new_cc + | (old_rep, new_rep, z)::rest -> + let successors = LMap.successors old_rep cc.map in + let new_reps, new_cc, reachable_old_reps = + List.fold (add_transition (old_rep, new_rep,z)) (new_reps, new_cc, []) successors in + add_transitions new_reps new_cc (rest@reachable_old_reps) + in add_transitions new_reps new_cc + (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) + + (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. + Returns None if there are no elements in the same equivalence class as t before it was deleted.*) + let find_new_root new_reps uf v = + match TMap.find_opt v new_reps with + | None -> None + | Some (new_t, z1) -> + let t_rep, z2 = TUF.find_no_pc uf new_t in + Some (t_rep, Z.(z2-z1)) + + let remove_terms_from_diseq diseq new_reps cc = + let disequalities = Disequalities.get_disequalities diseq + in + let add_disequality new_diseq = function + | Nequal(t1,t2,z) -> + begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with + | Some (t1',z1'), Some (t2', z2') -> (t1', t2', Z.(z2'+z-z1'))::new_diseq + | _ -> new_diseq + end + | _-> new_diseq + in + let new_diseq = List.fold add_disequality [] disequalities + in congruence_neq cc new_diseq + + let remove_terms_from_bldis bldis new_reps cc = + let disequalities = BlDis.to_conj bldis + in + let add_bl_dis new_diseq = function + | BlNequal (t1,t2) -> + begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with + | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq (t1', t2') + | _ -> new_diseq + end + | _-> new_diseq + in + List.fold add_bl_dis BlDis.empty disequalities + + (** Remove terms from the data structure. + It removes all terms for which "predicate" is false, + while maintaining all equalities about variables that are not being removed.*) + let remove_terms predicate cc = + let old_cc = cc in + match remove_terms_from_eq predicate cc with + | new_reps, Some cc -> + begin match remove_terms_from_diseq old_cc.diseq new_reps cc with + | Some cc -> + let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in + let min_repr, uf = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" + (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis}); + Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis} + | None -> None + end + | _,None -> None + + (* join *) + + let show_pmap pmap= + List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> + s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) + + let join_eq cc1 cc2 = + let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in + let mappings = List.map + (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in + let r2, off2 = TUF.find_no_pc cc2.uf a in + (r1,r2,Z.(off2 - off1)), (a,off1)) atoms in + let add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) = + match Map.find_opt new_element pmap with + | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs + | Some (c, c1_off) -> + pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in + let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some (init_cc []),[]) mappings in + (* add equalities that make sure that all atoms that have the same + representative are equal. *) + let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = + let a', a_off = TUF.find_no_pc cc1.uf a in + match LMap.map_find_opt (y, Z.(diff + offset)) cc2.map with + | None -> pmap,cc,new_pairs + | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in + match SSet.deref_term t Z.(offset - t1_off) cc1.set with + | exception (T.UnsupportedCilExpression _) -> pmap,cc,new_pairs + | new_term -> + let _ , cc = insert cc new_term in + let new_element = a',b',Z.(b_off - a_off) in + add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) + in + let rec add_edges_to_map pmap cc = function + | [] -> cc, pmap + | (x,y,diff)::rest -> + let t,t1_off = Map.find (x,y,diff) pmap in + let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off diff) (pmap, cc, []) (LMap.successors x cc1.map) in + add_edges_to_map pmap cc (rest@new_pairs) + in + add_edges_to_map pmap cc working_set + + (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) + let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = + let _,diseq1,_ = split (Disequalities.get_disequalities diseq1) in + let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in + (* keep all disequalities from diseq1 that are implied by cc2 and + those from diseq2 that are implied by cc1 *) + let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1) in + let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2) in + let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in + let res = congruence_neq cc (diseq1 @ diseq2) + in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res + + (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. *) + let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = + let bldiseq1 = BlDis.to_conj bldiseq1 in + let bldiseq2 = BlDis.to_conj bldiseq2 in + (* keep all disequalities from diseq1 that are implied by cc2 and + those from diseq2 that are implied by cc1 *) + let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1) in + let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2) in + let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in + let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in + let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms + in (if M.tracing then M.trace "wrpointer-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); + {cc with bldis} + +end + +include CongruenceClosure + +(**Find out if two addresses are not equal by using the MayPointTo query*) + module MayBeEqual = struct + + module AD = Queries.AD + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} + let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) + let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) + + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} + let return_var var = T.aux_term_of_varinfo (return_varinfo var) + let return_lval var = Lval (Var (return_varinfo var), NoOffset) + + let ask_may_point_to (ask: Queries.ask) exp = + match ask.f (MayPointTo exp) with + | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () + | res -> res + + let may_point_to_all_equal_terms ask exp cc term offset = + let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + let equal_terms = List.filter valid_term comp in + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); + let intersect_query_result res (term,z) = + let next_query = + match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with + | exception (T.UnsupportedCilExpression _) -> AD.top() + | res -> if AD.is_bot res then AD.top() else res + in + AD.meet res next_query in + List.fold intersect_query_result (AD.top()) equal_terms + + (**Find out if two addresses are possibly equal by using the MayPointTo query. *) + let may_point_to_address (ask:Queries.ask) adresses t2 off cc = + match T.to_cil_sum off (T.to_cil t2) with + | exception (T.UnsupportedCilExpression _) -> true + | exp2 -> + let mpt1 = adresses in + let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res + + let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = + if T.equal t1 t2 then true else + let exp1 = T.to_cil t1 in + let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in + let res = may_point_to_address ask mpt1 t2 off cc in + if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" + AD.pretty mpt1 (T.show t1) d_plainexp exp1; res + + let rec may_be_equal ask cc s t1 t2 = + let there_is_an_overlap s s' diff = + if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) + in + match t1, t2 with + | Deref (t, z,_), Deref (v, z',_) -> + let (q', z1') = TUF.find_no_pc cc.uf v in + let (q, z1) = TUF.find_no_pc cc.uf t in + let s' = T.get_size t2 in + let diff = Z.(-z' - z1 + z1' + z) in + (* If they are in the same equivalence class and they overlap, then they are equal *) + (if T.equal q' q && there_is_an_overlap s s' diff then true + else + (* If we have a disequality, then they are not equal *) + if neq_query (Some cc) (t,v,Z.(z'-z)) then false else + (* or if we know that they are not equal according to the query MayPointTo*) + (may_point_to_same_address ask t v Z.(z' - z) cc)) + || (may_be_equal ask cc s t1 v) + | Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) + | Addr _ , _ | Aux _, _ -> T.is_subterm t1 t2 + + (**Returns true iff by assigning to t1, the value of t2 could change. + The parameter s is the size in bits of the variable t1 we are assigning to. *) + let may_be_equal ask cc s t1 t2 = + match cc with + | None -> false + | Some cc -> + let res = (may_be_equal ask cc s t1 t2) in + if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + res + + let rec may_point_to_one_of_these_adresses ask adresses cc t2 = + match t2 with + | Deref (v, z',_) -> + (may_point_to_address ask adresses v z' cc) + || (may_point_to_one_of_these_adresses ask adresses cc v) + | Addr _ | Aux _ -> false + + end + + module D = struct + + include Printable.StdLeaf + + type domain = t option [@@deriving ord, hash] + type t = domain [@@deriving ord, hash] + + (** Convert to string *) + let show x = match x with + | None -> "⊥\n" + | Some x -> show_conj (get_normal_form x) + + let show_all = function + | None -> "⊥\n" + | Some x -> show_all x + + include Printable.SimpleShow(struct type t = domain let show = show end) + + let name () = "c2po" + + let equal x y = + if x == y then + true + else + let res = match x, y with + | Some x, Some y -> + (T.props_equal (get_normal_form x) (get_normal_form y)) + | None, None -> true + | _ -> false + in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} + + let init () = init_congruence [] + + let bot () = None + let is_bot x = Option.is_none x + let top () = empty () + let is_top = function None -> false + | Some cc -> TUF.is_empty cc.uf + + let join a b = + if a == b then + a + else + let res = + match a,b with + | None, b -> b + | a, None -> a + | Some a, Some b -> + if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(join_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) + in + if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" + (show_all res); + res + + let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b + + let meet a b = + if a == b then + a + else + match a,b with + | None, _ -> None + | _, None -> None + | Some a, b -> + let a_conj = get_normal_form a in + meet_conjs_opt a_conj b + + let leq x y = equal (meet x y) x + + let narrow = meet + + let pretty_diff () (x,y) = Pretty.dprintf "" + + let printXml f x = match x with + | Some x -> + BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" + (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) + (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) + (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) + (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) + (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) + (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) + | None -> BatPrintf.fprintf f "\nbottom\n\n" + + (** Remove terms from the data structure. + It removes all terms for which "var" is a subterm, + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variable var cc = + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); + Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) + + (** Remove terms from the data structure. + It removes all terms which contain one of the "vars", + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variables vars cc = + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + Option.bind cc (remove_terms (T.contains_variable vars)) + + (** Remove terms from the data structure. + It removes all terms which do not contain one of the "vars", + except the global vars are also keeped (when vstorage = static), + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_not_containing_variables vars cc = + if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) + + (** Remove terms from the data structure. + It removes all terms that may be changed after an assignment to "term".*) + let remove_may_equal_terms ask s term cc = + if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); + let cc = snd (insert cc term) in + Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) + + (** Remove terms from the data structure. + It removes all terms that may point to the same address as "tainted".*) + let remove_tainted_terms ask address cc = + if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; + Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) + + end diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 41aeb05a04..1d23f212bb 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -94,6 +94,7 @@ module MemLeak = MemLeak module UseAfterFree = UseAfterFree module MemOutOfBounds = MemOutOfBounds module WeaklyRelationalPointerAnalysis = WeaklyRelationalPointerAnalysis +module C2poAnalysis = C2poAnalysis (** {2 Concurrency} @@ -277,6 +278,7 @@ module StackDomain = StackDomain module CongruenceClosure = CongruenceClosure module UnionFind = UnionFind module WeaklyRelationalPointerDomain = WeaklyRelationalPointerDomain +module C2poDomain = C2poDomain (** {2 Testing} From 3629d9d97205579b30fac90081a8ef39fb282692 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 17:31:36 +0200 Subject: [PATCH 203/323] removed everything that has to do woth minimal representatives from c2po --- src/cdomains/c2poDomain.ml | 619 ++++++++++++++----------------------- 1 file changed, 235 insertions(+), 384 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 35d28de43e..d50f5dcdc0 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -420,114 +420,9 @@ module CongruenceClosure = struct end - (** Minimal representatives map. - It maps each representative term of an equivalence class to the minimal term of this representative class. - rep -> (t, z) means that t = rep + z *) - module MRMap = struct - type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] - - let bindings = TMap.bindings - let find = TMap.find - let find_opt = TMap.find_opt - let add = TMap.add - let remove = TMap.remove - let mem = TMap.mem - let empty = TMap.empty - - let show_min_rep min_representatives = - let show_one_rep s (state, (rep, z)) = - s ^ "\tState: " ^ T.show state ^ - "\n\tMin: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")--\n\n" - in - List.fold_left show_one_rep "" (bindings min_representatives) - - let rec update_min_repr (uf, set, map) min_representatives = function - | [] -> min_representatives, uf - | state::queue -> (* process all outgoing edges in order of ascending edge labels *) - match LMap.successors state map with - | edges -> - let process_edge (min_representatives, queue, uf) (edge_z, next_term) = - let next_state, next_z, uf = TUF.find uf next_term in - let (min_term, min_z) = find state min_representatives in - let next_min = - (SSet.deref_term_even_if_its_not_possible min_term Z.(edge_z - min_z) set, next_z) in - match TMap.find_opt next_state min_representatives - with - | None -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | _ -> (min_representatives, queue, uf) - in - let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges - in update_min_repr (uf, set, map) min_representatives queue - - (** Uses dijkstra algorithm to update the minimal representatives of - the successor nodes of all edges in the queue - and if necessary it recursively updates the minimal representatives of the successor nodes. - The states in the queue must already have an updated min_repr. - This function visits only the successor nodes of the nodes in queue, not the nodes themselves. - Before visiting the nodes, it sorts the queue by the size of the current mininmal representative. - - parameters: - - - `(uf, map)` represent the union find data structure and the corresponding lookup map. - - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. - - `queue` contains the states that need to be processed. - The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. - Therefore the queue is a list of representative terms. - - Returns: - - The map with the minimal representatives - - The union find tree. This might have changed because of path compression. *) - let update_min_repr (uf, set, map) min_representatives queue = - (* order queue by size of the current min representative *) - let queue = - List.sort_unique (fun el1 el2 -> let compare_repr = TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives) in - if compare_repr = 0 then T.compare el1 el2 else compare_repr) (List.filter (TUF.is_root uf) queue) - in update_min_repr (uf, set, map) min_representatives queue - - (** - Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. - It's used for now when removing elements, then the min_repr map gets recomputed. - - Returns: - - The map with the minimal representatives - - The union find tree. This might have changed because of path compression. *) - let compute_minimal_representatives (uf, set, map) = - if M.tracing then M.trace "wrpointer" "compute_minimal_representatives\n"; - let atoms = SSet.get_atoms set in - (* process all atoms in increasing order *) - let uf_ref = ref uf in - let atoms = - List.sort (fun el1 el2 -> - let v1, z1, new_uf = TUF.find !uf_ref el1 in - uf_ref := new_uf; - let v2, z2, new_uf = TUF.find !uf_ref el2 in - uf_ref := new_uf; - let repr_compare = TUF.compare_repr (v1, z1) (v2, z2) - in - if repr_compare = 0 then T.compare el1 el2 else repr_compare) atoms in - let add_atom_to_map (min_representatives, queue, uf) a = - let (rep, offs, uf) = TUF.find uf a in - if not (mem rep min_representatives) then - (add rep (a, offs) min_representatives, queue @ [rep], uf) - else (min_representatives, queue, uf) - in - let (min_representatives, queue, uf) = List.fold_left add_atom_to_map (empty, [], uf) atoms - (* compute the minimal representative of all remaining edges *) - in update_min_repr (uf, set, map) min_representatives queue - - (** Computes the initial map of minimal representatives. - It maps each element `e` in the set to `(e, 0)`. *) - let initial_minimal_representatives set = - List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) - end - type t = {uf: TUF.t; set: SSet.t; map: LMap.t; - min_repr: MRMap.t; diseq: Disequalities.t; bldis: BlDis.t} [@@deriving eq, ord, hash] @@ -561,44 +456,28 @@ module CongruenceClosure = struct let atoms = SSet.get_atoms cc.set in List.filter_map (fun atom -> let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in - let (min_state, min_z) = MRMap.find rep_state cc.min_repr in - normalize_equality (atom, min_state, Z.(rep_z - min_z)) + normalize_equality (atom, rep_state, rep_z) ) atoms in let conjunctions_of_transitions = let transitions = get_transitions (cc.uf, cc.map) in List.filter_map (fun (z,s,(s',z')) -> - let (min_state, min_z) = MRMap.find s cc.min_repr in - let (min_state', min_z') = MRMap.find s' cc.min_repr in - normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) + normalize_equality (SSet.deref_term_even_if_its_not_possible s z cc.set, s', z') ) transitions in (*disequalities*) let disequalities = Disequalities.get_disequalities cc.diseq in (* find disequalities between min_repr *) let normalize_disequality (t1, t2, z) = - let (min_state1, min_z1) = MRMap.find t1 cc.min_repr in - let (min_state2, min_z2) = MRMap.find t2 cc.min_repr in - let new_offset = Z.(-min_z2 + min_z1 + z) in - if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) - else Nequal (min_state2, min_state1, Z.(-new_offset)) + if T.compare t1 t2 < 0 then Nequal (t1, t2, z) + else Nequal (t2, t1, Z.(-z)) in - if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); + if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in (* block disequalities *) let normalize_bldis t = match t with | BlNequal (t1,t2) -> - let min_state1 = - begin match MRMap.find_opt t1 cc.min_repr with - | None -> t1 - | Some (a,_) -> a - end in - let min_state2 = - begin match MRMap.find_opt t2 cc.min_repr with - | None -> t2 - | Some (a,_) -> a - end in - if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) - else BlNequal (min_state2, min_state1) + if T.compare t1 t2 < 0 then BlNequal (t1, t2) + else BlNequal (t2, t1) | _ -> t in let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in @@ -613,8 +492,6 @@ module CongruenceClosure = struct ^ (SSet.show_set x.set) ^ "\nLookup map/transitions:\n" ^ (LMap.show_map x.map) - ^ "\nMinimal representatives:\n" - ^ (MRMap.show_min_rep x.min_repr) ^ "\nNeq:\n" ^ (Disequalities.show_neq x.diseq) ^ "\nBlock diseqs:\n" @@ -642,8 +519,7 @@ module CongruenceClosure = struct let (set, map) = SSet.subterms_of_conj conj in let uf = SSet.elements set |> TUF.init in - let min_repr = MRMap.initial_minimal_representatives set in - {uf; set; map; min_repr; diseq = Disequalities.empty; bldis=BlDis.empty} + {uf; set; map; diseq = Disequalities.empty; bldis=BlDis.empty} (** closure of disequalities *) let congruence_neq cc neg = @@ -658,7 +534,7 @@ module CongruenceClosure = struct let neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in if M.tracing then M.trace "wrpointer-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); - Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=cc.bldis} + Some {uf; set=cc.set; map=cc.map; diseq=neq; bldis=cc.bldis} with Unsat -> None (** @@ -677,18 +553,18 @@ module CongruenceClosure = struct Throws "Unsat" if a contradiction is found. *) - let rec closure (uf, map, min_repr, new_repr) queue = function - | [] -> (uf, map, queue, min_repr, new_repr) + let rec closure (uf, map, new_repr) = function + | [] -> (uf, map, new_repr) | (t1, t2, r)::rest -> (let v1, r1, uf = TUF.find uf t1 in let v2, r2, uf = TUF.find uf t2 in let sizet1, sizet2 = T.get_size t1, T.get_size t2 in if not (Z.equal sizet1 sizet2) then (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); - closure (uf, map, min_repr, new_repr) queue rest) else + closure (uf, map, new_repr) rest) else if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) - if Z.equal r1 Z.(r2 + r) then closure (uf, map, min_repr, new_repr) queue rest + if Z.equal r1 Z.(r2 + r) then closure (uf, map, new_repr) rest else raise Unsat else let diff_r = Z.(r2 - r1 + r) in let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) @@ -723,15 +599,7 @@ module CongruenceClosure = struct in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in LMap.remove v1 (LMap.add v zmap map), rest in - (* update min_repr *) - let min_v1, min_v2 = MRMap.find v1 min_repr, MRMap.find v2 min_repr in - (* 'changed' is true if the new_min is different than the old min *) - let new_min, changed = if T.compare (fst min_v1) (fst min_v2) < 0 then (min_v1, not b) else (min_v2, b) in - let new_min = (fst new_min, if b then Z.(snd new_min - diff_r) else Z.(snd new_min + diff_r)) in - let removed_v = if b then v2 else v1 in - let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in - let queue = v :: queue in - closure (uf, map, min_repr, new_repr) queue rest + closure (uf, map, new_repr) rest ) let update_bldis new_repr bldis = @@ -764,9 +632,9 @@ module CongruenceClosure = struct match cc with | None -> None | Some cc -> - let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in + let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in let bldis = update_bldis new_repr cc.bldis in - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] + congruence_neq {uf; set = cc.set; map; diseq=cc.diseq; bldis=bldis} [] (** Parameters: cc conjunctions. @@ -787,12 +655,9 @@ module CongruenceClosure = struct match cc with | None -> None | Some cc -> - let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in + let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in let bldis = update_bldis new_repr cc.bldis in - (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) - let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in - if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] + congruence_neq {uf; set = cc.set; map; diseq=cc.diseq; bldis=bldis} [] (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = @@ -814,29 +679,27 @@ module CongruenceClosure = struct and queue, that needs to be passed as a parameter to `update_min_repr`. `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. *) - let rec insert_no_min_repr cc t = + let rec insert cc t = if SSet.mem t cc.set then let v,z,uf = TUF.find cc.uf t in - (v,z), Some {cc with uf}, [] + (v,z), Some {cc with uf} else match t with | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in - let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), Some {cc with uf; set; min_repr;}, [t] + (t, Z.zero), Some {cc with uf; set;} | Deref (t', z, exp) -> - match insert_no_min_repr cc t' with - | (v, r), None, queue -> (v, r), None, [] - | (v, r), Some cc, queue -> - let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in + match insert cc t' with + | (v, r), None -> (v, r), None + | (v, r), Some cc -> let set = SSet.add t cc.set in match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)], v::queue + (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)] | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq; bldis=cc.bldis}, v::queue + (t, Z.zero), Some {uf; set; map; diseq = cc.diseq; bldis=cc.bldis} (** Add a term to the data structure. @@ -844,23 +707,13 @@ module CongruenceClosure = struct let insert cc t = match cc with | None -> (t, Z.zero), None - | Some cc -> - match insert_no_min_repr cc t with - | v, None, queue -> v, None - | v, Some cc, queue -> - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} + | Some cc -> insert cc t (** Add all terms in a specific set to the data structure. Returns updated (uf, set, map, min_repr). *) let insert_set cc t_set = - match SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = Option.map_default (fun cc -> insert_no_min_repr cc t) ((t, Z.zero), None, []) cc in (cc, queue @ a_queue) ) t_set (cc, []) with - | None, queue -> None - | Some cc, queue -> - (* update min_repr at the end for more efficiency *) - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} + SSet.fold (fun t cc -> snd (insert cc t)) t_set cc (** Returns true if t1 and t2 are equivalent. *) let rec eq_query cc (t1,t2,r) = @@ -947,7 +800,7 @@ module CongruenceClosure = struct let remove_terms_from_eq predicate cc = let rec insert_terms cc = - function | [] -> cc | t::ts -> insert_terms (Option.bind cc (fun cc -> Tuple3.second (insert_no_min_repr cc t))) ts in + function | [] -> cc | t::ts -> insert_terms (snd (insert cc t)) ts in (* start from all initial states that are still valid and find new representatives if necessary *) (* new_reps maps each representative term to the new representative of the equivalence class *) (*but new_reps contains an element but not necessarily the representative!!*) @@ -1060,10 +913,9 @@ module CongruenceClosure = struct begin match remove_terms_from_diseq old_cc.diseq new_reps cc with | Some cc -> let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - let min_repr, uf = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" - (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis}); - Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis} + if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" + (show_all old_cc) (show_all {cc with bldis}); + Some {cc with bldis} | None -> None end | _,None -> None @@ -1140,221 +992,220 @@ end include CongruenceClosure (**Find out if two addresses are not equal by using the MayPointTo query*) - module MayBeEqual = struct - - module AD = Queries.AD - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} - let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) - let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} - let return_var var = T.aux_term_of_varinfo (return_varinfo var) - let return_lval var = Lval (Var (return_varinfo var), NoOffset) - - let ask_may_point_to (ask: Queries.ask) exp = - match ask.f (MayPointTo exp) with - | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () - | res -> res - - let may_point_to_all_equal_terms ask exp cc term offset = - let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" - d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); - let intersect_query_result res (term,z) = - let next_query = - match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with - | exception (T.UnsupportedCilExpression _) -> AD.top() - | res -> if AD.is_bot res then AD.top() else res - in - AD.meet res next_query in - List.fold intersect_query_result (AD.top()) equal_terms - - (**Find out if two addresses are possibly equal by using the MayPointTo query. *) - let may_point_to_address (ask:Queries.ask) adresses t2 off cc = - match T.to_cil_sum off (T.to_cil t2) with - | exception (T.UnsupportedCilExpression _) -> true - | exp2 -> - let mpt1 = adresses in - let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" - AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res - - let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = - if T.equal t1 t2 then true else - let exp1 = T.to_cil t1 in - let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in - let res = may_point_to_address ask mpt1 t2 off cc in - if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" - AD.pretty mpt1 (T.show t1) d_plainexp exp1; res - - let rec may_be_equal ask cc s t1 t2 = - let there_is_an_overlap s s' diff = - if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) +module MayBeEqual = struct + + module AD = Queries.AD + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} + let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) + let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) + + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} + let return_var var = T.aux_term_of_varinfo (return_varinfo var) + let return_lval var = Lval (Var (return_varinfo var), NoOffset) + + let ask_may_point_to (ask: Queries.ask) exp = + match ask.f (MayPointTo exp) with + | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () + | res -> res + + let may_point_to_all_equal_terms ask exp cc term offset = + let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + let equal_terms = List.filter valid_term comp in + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); + let intersect_query_result res (term,z) = + let next_query = + match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with + | exception (T.UnsupportedCilExpression _) -> AD.top() + | res -> if AD.is_bot res then AD.top() else res in - match t1, t2 with - | Deref (t, z,_), Deref (v, z',_) -> - let (q', z1') = TUF.find_no_pc cc.uf v in - let (q, z1) = TUF.find_no_pc cc.uf t in - let s' = T.get_size t2 in - let diff = Z.(-z' - z1 + z1' + z) in - (* If they are in the same equivalence class and they overlap, then they are equal *) - (if T.equal q' q && there_is_an_overlap s s' diff then true - else - (* If we have a disequality, then they are not equal *) - if neq_query (Some cc) (t,v,Z.(z'-z)) then false else - (* or if we know that they are not equal according to the query MayPointTo*) - (may_point_to_same_address ask t v Z.(z' - z) cc)) - || (may_be_equal ask cc s t1 v) - | Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) - | Addr _ , _ | Aux _, _ -> T.is_subterm t1 t2 - - (**Returns true iff by assigning to t1, the value of t2 could change. - The parameter s is the size in bits of the variable t1 we are assigning to. *) - let may_be_equal ask cc s t1 t2 = - match cc with - | None -> false - | Some cc -> - let res = (may_be_equal ask cc s t1 t2) in - if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; - res + AD.meet res next_query in + List.fold intersect_query_result (AD.top()) equal_terms + + (**Find out if two addresses are possibly equal by using the MayPointTo query. *) + let may_point_to_address (ask:Queries.ask) adresses t2 off cc = + match T.to_cil_sum off (T.to_cil t2) with + | exception (T.UnsupportedCilExpression _) -> true + | exp2 -> + let mpt1 = adresses in + let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res + + let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = + if T.equal t1 t2 then true else + let exp1 = T.to_cil t1 in + let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in + let res = may_point_to_address ask mpt1 t2 off cc in + if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" + AD.pretty mpt1 (T.show t1) d_plainexp exp1; res + + let rec may_be_equal ask cc s t1 t2 = + let there_is_an_overlap s s' diff = + if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) + in + match t1, t2 with + | Deref (t, z,_), Deref (v, z',_) -> + let (q', z1') = TUF.find_no_pc cc.uf v in + let (q, z1) = TUF.find_no_pc cc.uf t in + let s' = T.get_size t2 in + let diff = Z.(-z' - z1 + z1' + z) in + (* If they are in the same equivalence class and they overlap, then they are equal *) + (if T.equal q' q && there_is_an_overlap s s' diff then true + else + (* If we have a disequality, then they are not equal *) + if neq_query (Some cc) (t,v,Z.(z'-z)) then false else + (* or if we know that they are not equal according to the query MayPointTo*) + (may_point_to_same_address ask t v Z.(z' - z) cc)) + || (may_be_equal ask cc s t1 v) + | Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) + | Addr _ , _ | Aux _, _ -> T.is_subterm t1 t2 + + (**Returns true iff by assigning to t1, the value of t2 could change. + The parameter s is the size in bits of the variable t1 we are assigning to. *) + let may_be_equal ask cc s t1 t2 = + match cc with + | None -> false + | Some cc -> + let res = (may_be_equal ask cc s t1 t2) in + if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + res - let rec may_point_to_one_of_these_adresses ask adresses cc t2 = - match t2 with - | Deref (v, z',_) -> - (may_point_to_address ask adresses v z' cc) - || (may_point_to_one_of_these_adresses ask adresses cc v) - | Addr _ | Aux _ -> false + let rec may_point_to_one_of_these_adresses ask adresses cc t2 = + match t2 with + | Deref (v, z',_) -> + (may_point_to_address ask adresses v z' cc) + || (may_point_to_one_of_these_adresses ask adresses cc v) + | Addr _ | Aux _ -> false - end +end - module D = struct +module D = struct - include Printable.StdLeaf + include Printable.StdLeaf - type domain = t option [@@deriving ord, hash] - type t = domain [@@deriving ord, hash] + type domain = t option [@@deriving ord, hash] + type t = domain [@@deriving ord, hash] - (** Convert to string *) - let show x = match x with - | None -> "⊥\n" - | Some x -> show_conj (get_normal_form x) + (** Convert to string *) + let show x = match x with + | None -> "⊥\n" + | Some x -> show_conj (get_normal_form x) - let show_all = function - | None -> "⊥\n" - | Some x -> show_all x + let show_all = function + | None -> "⊥\n" + | Some x -> show_all x - include Printable.SimpleShow(struct type t = domain let show = show end) + include Printable.SimpleShow(struct type t = domain let show = show end) - let name () = "c2po" + let name () = "c2po" - let equal x y = - if x == y then - true - else - let res = match x, y with - | Some x, Some y -> - (T.props_equal (get_normal_form x) (get_normal_form y)) - | None, None -> true - | _ -> false - in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res - - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} - - let init () = init_congruence [] - - let bot () = None - let is_bot x = Option.is_none x - let top () = empty () - let is_top = function None -> false - | Some cc -> TUF.is_empty cc.uf - - let join a b = - if a == b then - a - else - let res = - match a,b with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) - in - if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" - (show_all res); - res + let equal x y = + if x == y then + true + else + let res = match x, y with + | Some x, Some y -> + (T.props_equal (get_normal_form x) (get_normal_form y)) + | None, None -> true + | _ -> false + in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} + + let init () = init_congruence [] + + let bot () = None + let is_bot x = Option.is_none x + let top () = empty () + let is_top = function None -> false + | Some cc -> TUF.is_empty cc.uf + + let join a b = + if a == b then + a + else + let res = + match a,b with + | None, b -> b + | a, None -> a + | Some a, Some b -> + if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(join_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) + in + if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" + (show_all res); + res - let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b + let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b - let meet a b = - if a == b then - a - else - match a,b with - | None, _ -> None - | _, None -> None - | Some a, b -> - let a_conj = get_normal_form a in - meet_conjs_opt a_conj b - - let leq x y = equal (meet x y) x - - let narrow = meet - - let pretty_diff () (x,y) = Pretty.dprintf "" - - let printXml f x = match x with - | Some x -> - BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" - (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) - (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) - (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) - (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) - (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) - (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) - | None -> BatPrintf.fprintf f "\nbottom\n\n" - - (** Remove terms from the data structure. - It removes all terms for which "var" is a subterm, - while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variable var cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) - - (** Remove terms from the data structure. - It removes all terms which contain one of the "vars", - while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (T.contains_variable vars)) - - (** Remove terms from the data structure. - It removes all terms which do not contain one of the "vars", - except the global vars are also keeped (when vstorage = static), - while maintaining all equalities about variables that are not being removed.*) - let remove_terms_not_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) - - (** Remove terms from the data structure. - It removes all terms that may be changed after an assignment to "term".*) - let remove_may_equal_terms ask s term cc = - if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); - let cc = snd (insert cc term) in - Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) - - (** Remove terms from the data structure. - It removes all terms that may point to the same address as "tainted".*) - let remove_tainted_terms ask address cc = - if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) + let meet a b = + if a == b then + a + else + match a,b with + | None, _ -> None + | _, None -> None + | Some a, b -> + let a_conj = get_normal_form a in + meet_conjs_opt a_conj b - end + let leq x y = equal (meet x y) x + + let narrow = meet + + let pretty_diff () (x,y) = Pretty.dprintf "" + + let printXml f x = match x with + | Some x -> + BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" + (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) + (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) + (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) + (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) + (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) + | None -> BatPrintf.fprintf f "\nbottom\n\n" + + (** Remove terms from the data structure. + It removes all terms for which "var" is a subterm, + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variable var cc = + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); + Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) + + (** Remove terms from the data structure. + It removes all terms which contain one of the "vars", + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_variables vars cc = + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + Option.bind cc (remove_terms (T.contains_variable vars)) + + (** Remove terms from the data structure. + It removes all terms which do not contain one of the "vars", + except the global vars are also keeped (when vstorage = static), + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_not_containing_variables vars cc = + if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) + + (** Remove terms from the data structure. + It removes all terms that may be changed after an assignment to "term".*) + let remove_may_equal_terms ask s term cc = + if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); + let cc = snd (insert cc term) in + Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) + + (** Remove terms from the data structure. + It removes all terms that may point to the same address as "tainted".*) + let remove_tainted_terms ask address cc = + if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; + Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) + +end From 0eca7957fb58b1bd9ab384a43d8a8d6896c8ae3f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 18:18:09 +0200 Subject: [PATCH 204/323] added exactly the same tests as the wrpointer tests also to c2po. They work for now because I still haven't modified the implementation of of removing the terms --- tests/regression/83-2cpo/01-simple.c | 20 ++++++ tests/regression/83-2cpo/02-rel-simple.c | 70 +++++++++++++++++++ tests/regression/83-2cpo/03-function-call.c | 29 ++++++++ tests/regression/83-2cpo/04-remove-vars.c | 23 ++++++ tests/regression/83-2cpo/05-branch.c | 47 +++++++++++++ .../83-2cpo/06-invertible-assignment.c | 17 +++++ .../83-2cpo/07-invertible-assignment2.c | 22 ++++++ .../regression/83-2cpo/08-simple-assignment.c | 15 ++++ .../regression/83-2cpo/09-different-offsets.c | 20 ++++++ tests/regression/83-2cpo/10-different-types.c | 38 ++++++++++ tests/regression/83-2cpo/11-array.c | 21 ++++++ tests/regression/83-2cpo/12-rel-function.c | 22 ++++++ tests/regression/83-2cpo/13-experiments.c | 42 +++++++++++ tests/regression/83-2cpo/14-join.c | 23 ++++++ tests/regression/83-2cpo/15-arrays-structs.c | 62 ++++++++++++++++ tests/regression/83-2cpo/16-loops.c | 28 ++++++++ tests/regression/83-2cpo/17-join2.c | 21 ++++++ .../regression/83-2cpo/18-complicated-join.c | 24 +++++++ tests/regression/83-2cpo/19-disequalities.c | 40 +++++++++++ .../83-2cpo/20-self-pointing-struct.c | 21 ++++++ tests/regression/83-2cpo/21-global-var.c | 40 +++++++++++ tests/regression/83-2cpo/22-join-diseq.c | 37 ++++++++++ tests/regression/83-2cpo/23-function-deref.c | 25 +++++++ .../83-2cpo/24-disequalities-small-example.c | 12 ++++ tests/regression/83-2cpo/25-struct-circular.c | 28 ++++++++ tests/regression/83-2cpo/26-join3.c | 45 ++++++++++++ tests/regression/83-2cpo/27-join-diseq2.c | 39 +++++++++++ tests/regression/83-2cpo/28-return-value.c | 16 +++++ tests/regression/83-2cpo/29-widen.c | 25 +++++++ 29 files changed, 872 insertions(+) create mode 100644 tests/regression/83-2cpo/01-simple.c create mode 100644 tests/regression/83-2cpo/02-rel-simple.c create mode 100644 tests/regression/83-2cpo/03-function-call.c create mode 100644 tests/regression/83-2cpo/04-remove-vars.c create mode 100644 tests/regression/83-2cpo/05-branch.c create mode 100644 tests/regression/83-2cpo/06-invertible-assignment.c create mode 100644 tests/regression/83-2cpo/07-invertible-assignment2.c create mode 100644 tests/regression/83-2cpo/08-simple-assignment.c create mode 100644 tests/regression/83-2cpo/09-different-offsets.c create mode 100644 tests/regression/83-2cpo/10-different-types.c create mode 100644 tests/regression/83-2cpo/11-array.c create mode 100644 tests/regression/83-2cpo/12-rel-function.c create mode 100644 tests/regression/83-2cpo/13-experiments.c create mode 100644 tests/regression/83-2cpo/14-join.c create mode 100644 tests/regression/83-2cpo/15-arrays-structs.c create mode 100644 tests/regression/83-2cpo/16-loops.c create mode 100644 tests/regression/83-2cpo/17-join2.c create mode 100644 tests/regression/83-2cpo/18-complicated-join.c create mode 100644 tests/regression/83-2cpo/19-disequalities.c create mode 100644 tests/regression/83-2cpo/20-self-pointing-struct.c create mode 100644 tests/regression/83-2cpo/21-global-var.c create mode 100644 tests/regression/83-2cpo/22-join-diseq.c create mode 100644 tests/regression/83-2cpo/23-function-deref.c create mode 100644 tests/regression/83-2cpo/24-disequalities-small-example.c create mode 100644 tests/regression/83-2cpo/25-struct-circular.c create mode 100644 tests/regression/83-2cpo/26-join3.c create mode 100644 tests/regression/83-2cpo/27-join-diseq2.c create mode 100644 tests/regression/83-2cpo/28-return-value.c create mode 100644 tests/regression/83-2cpo/29-widen.c diff --git a/tests/regression/83-2cpo/01-simple.c b/tests/regression/83-2cpo/01-simple.c new file mode 100644 index 0000000000..abb6b2c69a --- /dev/null +++ b/tests/regression/83-2cpo/01-simple.c @@ -0,0 +1,20 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +void main(void) { + int *i; + int **j; + j = (int**)malloc(sizeof(int*)+7); + *(j + 3) = (int *)malloc(sizeof(int)); + int *k; + i = *(j + 3); + *j = k; + + __goblint_check(**j == *k); + __goblint_check(i == *(j + 3)); + + j = &k + 1; + + __goblint_check(j == &k); // FAIL +} diff --git a/tests/regression/83-2cpo/02-rel-simple.c b/tests/regression/83-2cpo/02-rel-simple.c new file mode 100644 index 0000000000..0e42b79ce8 --- /dev/null +++ b/tests/regression/83-2cpo/02-rel-simple.c @@ -0,0 +1,70 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include +#include + +int main(void) { + int *i = (int *)malloc(sizeof(int)); + int ***j = (int ***)malloc(sizeof(int) * 4); + int **j2 = (int **)malloc(sizeof(int)); + int **j23 = (int **)malloc(sizeof(int)); + *j = j2; + *(j + 3) = j23; + int *j3 = (int *)malloc(sizeof(int)); + int *j33 = (int *)malloc(sizeof(int)); + *j2 = j3; + **(j + 3) = j33; + *j3 = 4; + *j33 = 5; + int *k = i; + *k = 3; + // j --> *j=j2 --> **j=j3 --> ***j=|4| + // (j+3) --> j23 --> j33 --> |5| + // k=i --> |3| + + // printf("***j = %d\n", ***j); // 4 + // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + // printf("*i = %d\n", *i); // 3 + // printf("*k = %d\n", *k); // 3 + // printf("\n"); + + __goblint_check(*j23 == j33); + __goblint_check(*j2 == j3); + __goblint_check(*i == *k); + + i = **(j + 3); + + // j --> *j=j2 --> **j=j3 --> ***j=|4| + // (j+3) --> j23 --> j33=i --> |5| + // k --> |3| + + // printf("***j = %d\n", ***j); // 4 + // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + // printf("*i = %d\n", *i); // 5 + // printf("*k = %d\n", *k); // 3 + // printf("\n"); + + __goblint_check(*j23 == j33); + __goblint_check(*j2 == j3); + __goblint_check(*i == *j33); + + *j = &k; + + // j2 --> j3 --> |4| + // (j+3) --> j23 --> j33=i --> |5| + // j --> *j --> k --> |3| + + // printf("***j = %d\n", ***j); // 3 + // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 + // printf("*i = %d\n", *i); // 5 + // printf("*k = %d\n", *k); // 3 + // printf("**j2 = %d\n", **j2); // 4 + + __goblint_check(*j23 == j33); + __goblint_check(*j2 == j3); + __goblint_check(**j == k); + + // not assignable: &k = *j; + + return 0; +} diff --git a/tests/regression/83-2cpo/03-function-call.c b/tests/regression/83-2cpo/03-function-call.c new file mode 100644 index 0000000000..7c4f305d27 --- /dev/null +++ b/tests/regression/83-2cpo/03-function-call.c @@ -0,0 +1,29 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +int *i; +int **j; + +int *f(int **a, int *b) { return *a; } + +int *g(int **a, int *b) { + a = (int **)malloc(sizeof(int *)); + return *a; +} + +int main(void) { + + j = (int **)malloc(sizeof(int *)); + *j = (int *)malloc(sizeof(int)); + int *k = f(j, i); + + __goblint_check(k == *j); + + k = g(j, i); + + __goblint_check(k == *j); // UNKNOWN! + + return 0; +} diff --git a/tests/regression/83-2cpo/04-remove-vars.c b/tests/regression/83-2cpo/04-remove-vars.c new file mode 100644 index 0000000000..b5e906bd9c --- /dev/null +++ b/tests/regression/83-2cpo/04-remove-vars.c @@ -0,0 +1,23 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +int *f(int **j) { + int *i = (int *)malloc(sizeof(int)); + + *j = i; + + return i; +} + +int main(void) { + int *i; + int **j; + j = (int**)malloc(sizeof(int*)); + *j = (int *)malloc(sizeof(int)); + int *k = f(j); + + __goblint_check(k == *j); + + return 0; +} diff --git a/tests/regression/83-2cpo/05-branch.c b/tests/regression/83-2cpo/05-branch.c new file mode 100644 index 0000000000..7d8b3bbd99 --- /dev/null +++ b/tests/regression/83-2cpo/05-branch.c @@ -0,0 +1,47 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +void main(void) { + int *i; + int **j; + int *k; + i = *(j + 3); + *j = k; + j = &k + 1; + int *f; + if (j != &k) { + f = k; + printf("branch2"); + __goblint_check(1); // reachable + } else { + f = i; + printf("branch1"); + __goblint_check(0); // NOWARN (unreachable) + } + + __goblint_check(f == k); + + j = &k; + if (j != &k) { + f = k; + printf("branch1"); + __goblint_check(0); // NOWARN (unreachable) + } else { + f = i; + printf("branch2"); + __goblint_check(1); // reachable + } + + __goblint_check(f == i); + + if (**j + *k * 23 - 2 * *k == 0 && j != &k) { + f = k; + printf("branch1"); + __goblint_check(0); // NOWARN (unreachable) + } else { + f = i; + printf("branch2"); + __goblint_check(1); // reachable + } +} diff --git a/tests/regression/83-2cpo/06-invertible-assignment.c b/tests/regression/83-2cpo/06-invertible-assignment.c new file mode 100644 index 0000000000..420e8117f3 --- /dev/null +++ b/tests/regression/83-2cpo/06-invertible-assignment.c @@ -0,0 +1,17 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include + +void main(void) { + long *i; + long **j; + long *k; + j = &k + 1; + j++; + __goblint_check(j == &k + 2); + + i = *(j + 3); + i++; + __goblint_check(i == *(j + 3) + 1); + j++; + __goblint_check(i == *(j + 2) + 1); +} diff --git a/tests/regression/83-2cpo/07-invertible-assignment2.c b/tests/regression/83-2cpo/07-invertible-assignment2.c new file mode 100644 index 0000000000..ca4b53b2ff --- /dev/null +++ b/tests/regression/83-2cpo/07-invertible-assignment2.c @@ -0,0 +1,22 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// example of the paper "2-Pointer Logic" by Seidl et al., Example 9, pag. 22 +#include +#include + +void main(void) { + long x; + long *z; + z = &x; + long y; + + y = -1 + x; + + __goblint_check(z == &x); + __goblint_check(y == -1 + x); + + *z = 1 + x; + + __goblint_check(&x == z); + __goblint_check(y == -2 + x); + +} diff --git a/tests/regression/83-2cpo/08-simple-assignment.c b/tests/regression/83-2cpo/08-simple-assignment.c new file mode 100644 index 0000000000..5d80308f07 --- /dev/null +++ b/tests/regression/83-2cpo/08-simple-assignment.c @@ -0,0 +1,15 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// example of the paper "2-Pointer Logic" by Seidl et al., pag. 21 +#include + +void main(void) { + long x; + long *z = -1 + &x; + + __goblint_check(z == -1 + &x); + + z = (long*) *(1 + z); + + __goblint_check(x == (long)z); + +} diff --git a/tests/regression/83-2cpo/09-different-offsets.c b/tests/regression/83-2cpo/09-different-offsets.c new file mode 100644 index 0000000000..964b6d7f3f --- /dev/null +++ b/tests/regression/83-2cpo/09-different-offsets.c @@ -0,0 +1,20 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +struct Pair { + int *first; + int *second; +}; + +void main(void) { + int *x; + struct Pair p; + p.first = x; + + struct Pair p2; + p2.first = x; + + __goblint_check(p.first == p2.first); + +} diff --git a/tests/regression/83-2cpo/10-different-types.c b/tests/regression/83-2cpo/10-different-types.c new file mode 100644 index 0000000000..78e3df9dc9 --- /dev/null +++ b/tests/regression/83-2cpo/10-different-types.c @@ -0,0 +1,38 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +void main(void) { + // no problem if they are all ints + int *ipt = (int *)malloc(sizeof(int)); + int *ipt2; + int i; + ipt = &i; + // *ipt: 0; i: 0 + __goblint_check(*ipt == i); + ipt2 = (int *)ipt; + *(ipt2 + 1) = 'a'; + // *ipt: 0; i: 0 + __goblint_check(*ipt == i); + + // long pointer is cast to char pointer -> *(cpt + 1) overwrites *lpt + long *lpt = (long *)malloc(sizeof(long)); + char *cpt; + long lo; + *lpt = lo; + // *lpt: 0; l: 0 + __goblint_check(*lpt == lo); + cpt = (char *)lpt; + *(cpt + 1) = 'a'; + + // *lpt: 24832; l: 0 + __goblint_check(*lpt == lo); // UNKNOWN! + + lo = 0; + *lpt = lo; + // *lpt: 0; l: 0 + __goblint_check(*lpt == lo); + *((char *)lpt + 1) = 'a'; + // *lpt: 24832; l: 0 + __goblint_check(*lpt == lo); // UNKNOWN! +} diff --git a/tests/regression/83-2cpo/11-array.c b/tests/regression/83-2cpo/11-array.c new file mode 100644 index 0000000000..2b6c264852 --- /dev/null +++ b/tests/regression/83-2cpo/11-array.c @@ -0,0 +1,21 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +void main(void) { + int m[5]; + + int **j; + int *l; + j = (int **)malloc(sizeof(int *) + 7); + j[3] = (int *)malloc(sizeof(int)); + int *k; + l = j[3]; + j[0] = k; + j[2] = m; + + __goblint_check(**j == *k); + __goblint_check(l == *(j + 3)); + __goblint_check(j[2] == m); + +} diff --git a/tests/regression/83-2cpo/12-rel-function.c b/tests/regression/83-2cpo/12-rel-function.c new file mode 100644 index 0000000000..ee7db3b01c --- /dev/null +++ b/tests/regression/83-2cpo/12-rel-function.c @@ -0,0 +1,22 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +void *f(int **a, int **b) { + int *j; + int **i = &j; + j = (int *)malloc(sizeof(int) * 2); + *a = j; + *b = *i + 1; +} + +int main(void) { + int **c = (int**)malloc(sizeof(int*)); + int **d = (int**)malloc(sizeof(int*));; + f(c, d); + + __goblint_check(*d == *c + 1); + + return 0; +} diff --git a/tests/regression/83-2cpo/13-experiments.c b/tests/regression/83-2cpo/13-experiments.c new file mode 100644 index 0000000000..ef943c80ba --- /dev/null +++ b/tests/regression/83-2cpo/13-experiments.c @@ -0,0 +1,42 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +struct Pair { + int (*first)[7]; + int second; +}; + +struct Crazy { + int whatever; + int arr[5]; +}; + +void main(void) { + int arr[7] = {1, 2, 3, 4, 5, 6, 7}; + int(*x)[7] = (int(*)[7])malloc(sizeof(int)); + struct Pair p; + p.first = x; + p.second = (*x)[3]; + + struct Pair p2; + p2.first = x; + + __goblint_check(p.first == p2.first); + + int arr2[2][2] = {{1, 2}, {1, 2}}; + p.second = arr2[1][1]; + + int *test; + + int *x2[2] = {test, test}; + + int test2 = *(x2[1]); + + struct Crazy crazyy[3][2]; + + __goblint_check(crazyy[2][1].arr[4] == ((struct Crazy *)crazyy)[5].arr[4]); + + int *sx[4]; + int k = *sx[1]; +} diff --git a/tests/regression/83-2cpo/14-join.c b/tests/regression/83-2cpo/14-join.c new file mode 100644 index 0000000000..b35d946c49 --- /dev/null +++ b/tests/regression/83-2cpo/14-join.c @@ -0,0 +1,23 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include + +void main(void) { + long y; + long i; + long x; + long *z; + int top; + + if (top) { + z = -1 + &x; + y = x; + } else { + z = -1 + &x; + i = x; + } + + __goblint_check(z == -1 + &x); + __goblint_check(x == i); // UNKNOWN! + __goblint_check(y == x); // UNKNOWN! +} diff --git a/tests/regression/83-2cpo/15-arrays-structs.c b/tests/regression/83-2cpo/15-arrays-structs.c new file mode 100644 index 0000000000..0e20866ce8 --- /dev/null +++ b/tests/regression/83-2cpo/15-arrays-structs.c @@ -0,0 +1,62 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +struct mystruct { + int first; + int second; +}; + +struct arrstruct { + int first[3]; + int second[3]; +}; + +void main(void) { + // array of struct + struct mystruct arrayStructs[3]; + + __goblint_check(arrayStructs[0].first == + ((int *)arrayStructs)[0]); // they are the same element + __goblint_check(arrayStructs[1].second == + ((int *)arrayStructs)[3]); // they are the same element + __goblint_check(arrayStructs[2].first == + ((int *)arrayStructs)[4]); // they are the same element + + // struct of array + struct arrstruct structArray; + int *pstruct = (int *)&structArray; // pointer to struct + __goblint_check(structArray.first[0] == + pstruct[0]); // they are the same element + __goblint_check(structArray.first[2] == + pstruct[2]); // they are the same element + __goblint_check(structArray.second[0] == + pstruct[3]); // they are the same element + __goblint_check(structArray.second[2] == + pstruct[5]); // they are the same element + + // array of array + int array2D[2][2] = {{1, 2}, {3, 4}}; + __goblint_check(array2D[0][0] == + *((int *)array2D + 0)); // they are the same element + __goblint_check(array2D[1][0] == + *((int *)array2D + 2)); // they are the same element + __goblint_check(array2D[1][1] == + *((int *)array2D + 3)); // they are the same element + + // arr2D[0][1] is the element and arr2D[2] is a pointer to an array + __goblint_check(array2D[0][1] == (long)array2D[2]); // UNKNOWN! + + __goblint_check((int *)array2D[0] + 4 == (int *)array2D[2]); + __goblint_check((int *)array2D + 4 == (int *)array2D[2]); + + __goblint_check(array2D[1][2] == *((int *)array2D + 4)); + __goblint_check((int *)array2D + 4 == (int *)array2D[2]); + + // 3D array + int array3D[2][3][4]; + __goblint_check(array3D[1][0][3] == *((int *)array3D + 15)); + __goblint_check(array3D[1][2][0] == *((int *)array3D + 20)); + __goblint_check(array3D[1][2][3] == *((int *)array3D + 23)); + __goblint_check(array3D[0][1][1] == *((int *)array3D + 5)); +} diff --git a/tests/regression/83-2cpo/16-loops.c b/tests/regression/83-2cpo/16-loops.c new file mode 100644 index 0000000000..f2a69b187c --- /dev/null +++ b/tests/regression/83-2cpo/16-loops.c @@ -0,0 +1,28 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +void main(void) { + long y; + long i; + long *x = malloc(sizeof(long) * 300); + long *x2 = x; + long *z; + int top; + top = top % 300; // top is some number that is < 300 + + y = *x; + z = -1 + x; + + while (top) { + z = (long *)malloc(sizeof(long)); + x++; + z = -1 + x; + y++; + top--; + } + + __goblint_check(z == -1 + x); + __goblint_check(y == *x2); // UNKNOWN! +} diff --git a/tests/regression/83-2cpo/17-join2.c b/tests/regression/83-2cpo/17-join2.c new file mode 100644 index 0000000000..97bcbdb2be --- /dev/null +++ b/tests/regression/83-2cpo/17-join2.c @@ -0,0 +1,21 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include + +void main(void) { + long *y = (long *)malloc(4 * sizeof(long)); + long a; + long b; + long *x = (long *)malloc(4 * sizeof(long)); + int top; + + if (top) { + *(x + 2) = a + 1; + *(y + 1) = a + 2; + } else { + *(x + 2) = b + 2; + *(y + 1) = b + 3; + } + + __goblint_check(*(x + 2) == *(y + 1) - 1); +} diff --git a/tests/regression/83-2cpo/18-complicated-join.c b/tests/regression/83-2cpo/18-complicated-join.c new file mode 100644 index 0000000000..75e212752e --- /dev/null +++ b/tests/regression/83-2cpo/18-complicated-join.c @@ -0,0 +1,24 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// Example 1 from the paper Join Algorithms for the Theory of Uninterpreted Functions by Gulwani et al. + +#include +#include + +void main(void) { + long ********y = (long ********)malloc(100 * sizeof(long *)); + *y = (long *******)malloc(100 * sizeof(long *)); + **y = (long ******)malloc(100 * sizeof(long *)); + int top; + + if (top) { + **y = (long ******)y; + __goblint_check(**y == (long ******)y); + __goblint_check(******y == (long **)y); + } else { + ***y = (long ***)y; + __goblint_check(***y == (long *****)y); + __goblint_check(******y == (long **)y); + } + // This does not work any more because the analysis is not precise enough + // __goblint_check(******y == (long**)y); +} diff --git a/tests/regression/83-2cpo/19-disequalities.c b/tests/regression/83-2cpo/19-disequalities.c new file mode 100644 index 0000000000..19f0ada21d --- /dev/null +++ b/tests/regression/83-2cpo/19-disequalities.c @@ -0,0 +1,40 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +void main(void) { + long *i; + long **j; + j = (int **)malloc(sizeof(int *) + 7); + *(j + 3) = (int *)malloc(sizeof(int)); + int *k; + *j = k; + + __goblint_check(**j != *k + 1); + __goblint_check(**j != *k + 2); + + if (*i != **(j + 3)) { + __goblint_check(i != *(j + 3)); + __goblint_check(&i != j + 3); + j = NULL; + __goblint_check(i != *(j + 3)); // UNKNOWN + } + + int *k2 = (int *)malloc(sizeof(int)); + *j = k2; + k = k2; + + __goblint_check(*j == k); + __goblint_check(k2 == k); + + int *f1 = (int *)malloc(sizeof(int)); + int *f2 = f2; + + if (*j != f2) { + __goblint_check(*j != f2); + __goblint_check(k != f1); + j = NULL; + __goblint_check(*j != f2); // UNKNOWN + __goblint_check(k != f1); + } +} diff --git a/tests/regression/83-2cpo/20-self-pointing-struct.c b/tests/regression/83-2cpo/20-self-pointing-struct.c new file mode 100644 index 0000000000..d8dd65230f --- /dev/null +++ b/tests/regression/83-2cpo/20-self-pointing-struct.c @@ -0,0 +1,21 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +#include +#include + +struct list { + int data; + struct list *next; +}; + +void main(void) { + struct list last = { + 41 + }; + struct list first = { + 42, &last + }; + + last.next = &last; + + __goblint_check(first.next->next->next->next == &last); +} diff --git a/tests/regression/83-2cpo/21-global-var.c b/tests/regression/83-2cpo/21-global-var.c new file mode 100644 index 0000000000..a4cf669f20 --- /dev/null +++ b/tests/regression/83-2cpo/21-global-var.c @@ -0,0 +1,40 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +int **i; +int **j; +int counter; + +void f() { __goblint_check(*i == *j); } + +void recursive_f() { + __goblint_check(*i == *j); + counter++; + if (counter < 25) + recursive_f(); +} + +void non_terminating_f() { + if (*i == *j) + non_terminating_f(); +} + +int main(void) { + + j = (int **)malloc(sizeof(int *)); + i = (int **)malloc(sizeof(int *)); + *i = (int *)malloc(sizeof(int)); + + *j = *i; + f(); + + recursive_f(); + + non_terminating_f(); + + __goblint_check(0); // NOWARN (unreachable) + + return 0; +} diff --git a/tests/regression/83-2cpo/22-join-diseq.c b/tests/regression/83-2cpo/22-join-diseq.c new file mode 100644 index 0000000000..97402da287 --- /dev/null +++ b/tests/regression/83-2cpo/22-join-diseq.c @@ -0,0 +1,37 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include + +void main(void) { + long *a; + long *b; + long *c; + long *d = (long *)malloc(4 * sizeof(long)); + long *e = (long *)malloc(4 * sizeof(long)); + + long *unknown; + + int top; + + if (a != b + 4 && e != c && c != d) { + __goblint_check(a != b + 4); + __goblint_check(e != c); + __goblint_check(c != d); + if (top) { + d = unknown; + __goblint_check(a != b + 4); + __goblint_check(e != c); + __goblint_check(c != d); // UNKNOWN! + + } else { + e = unknown; + __goblint_check(a != b + 4); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); + } + // JOIN + __goblint_check(a != b + 4); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); // UNKNOWN! + } +} diff --git a/tests/regression/83-2cpo/23-function-deref.c b/tests/regression/83-2cpo/23-function-deref.c new file mode 100644 index 0000000000..5e4a0778c6 --- /dev/null +++ b/tests/regression/83-2cpo/23-function-deref.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +void *g(int **a, int *b) { + b = (int *)malloc(sizeof(int *)); + *a = b; +} + +int main(void) { + int *i = (int *)malloc(sizeof(int)); + int **j; + j = (int **)malloc(sizeof(int *)); + *j = (int *)malloc(sizeof(int)); + int *k = *j; + + __goblint_check(k == *j); + + g(j, i); + + __goblint_check(k == *j); // UNKNOWN! + + return 0; +} diff --git a/tests/regression/83-2cpo/24-disequalities-small-example.c b/tests/regression/83-2cpo/24-disequalities-small-example.c new file mode 100644 index 0000000000..652efdf85c --- /dev/null +++ b/tests/regression/83-2cpo/24-disequalities-small-example.c @@ -0,0 +1,12 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +int *a, b; +c() { b = 0; } +main() { + int *d; + if (a == d) + ; + else + __goblint_check(a != d); + c(); +} diff --git a/tests/regression/83-2cpo/25-struct-circular.c b/tests/regression/83-2cpo/25-struct-circular.c new file mode 100644 index 0000000000..be237d0fcf --- /dev/null +++ b/tests/regression/83-2cpo/25-struct-circular.c @@ -0,0 +1,28 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include + +struct mem { + int val; +}; + +struct list_node { + int x; + struct mem *mem; + struct list_node *next; +}; + +int main() { + struct mem *m = malloc(sizeof(*m)); + int x = ((struct mem *) m)->val; + m->val = 100; + + struct list_node *head = malloc(sizeof(*head)); + + head->x = 1; + head->mem = m; + head->next = head; + + __goblint_check(head->next == head); + __goblint_check(head->next->next == head->next); +} diff --git a/tests/regression/83-2cpo/26-join3.c b/tests/regression/83-2cpo/26-join3.c new file mode 100644 index 0000000000..ae6b5ae743 --- /dev/null +++ b/tests/regression/83-2cpo/26-join3.c @@ -0,0 +1,45 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include +#include + +void main(void) { + long *x; + long *y; + long *z = malloc(sizeof(long)); + int top; + + if (top) { + x = z + 7; + y = z + 3; + } else { + x = z + 1; + y = z + 1; + } + + __goblint_check(x == z + 7); // UNKNOWN! + __goblint_check(x == z + 3); // UNKNOWN! + __goblint_check(x == z + 1); // UNKNOWN! + __goblint_check(x == z + 1); // UNKNOWN! + + long *x1; + long *x2; + long *y1; + long *y2; + + if (top) { + x1 = z + 1; + y1 = z + 2; + x2 = z + 1; + y2 = z + 2; + } else { + x1 = z + 2; + y1 = z + 3; + x2 = z + 4; + y2 = z + 5; + } + + __goblint_check(x1 == y1 - 1); + __goblint_check(x2 == y2 - 1); +} diff --git a/tests/regression/83-2cpo/27-join-diseq2.c b/tests/regression/83-2cpo/27-join-diseq2.c new file mode 100644 index 0000000000..7335cf7811 --- /dev/null +++ b/tests/regression/83-2cpo/27-join-diseq2.c @@ -0,0 +1,39 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +#include +#include + +int main(void) { + long *a; + long *b; + long *c; + long *d = (long *)malloc(4 * sizeof(long)); + long *e = (long *)malloc(4 * sizeof(long)); + + long *unknown; + + int top; + + if (a != b && e != c && c != d) { + __goblint_check(a != b); + __goblint_check(e != c); + __goblint_check(c != d); + if (top) { + d = unknown; + d = c + 1; + __goblint_check(a != b); + __goblint_check(e != c); + __goblint_check(c != d); // implicit disequality + } else { + e = unknown; + __goblint_check(a != b); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); + } + // JOIN + __goblint_check(a != b); + __goblint_check(e != c); // UNKNOWN! + __goblint_check(c != d); + } + return 0; +} diff --git a/tests/regression/83-2cpo/28-return-value.c b/tests/regression/83-2cpo/28-return-value.c new file mode 100644 index 0000000000..de277e2320 --- /dev/null +++ b/tests/regression/83-2cpo/28-return-value.c @@ -0,0 +1,16 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +int a, b, c; +void *d(const *e) { return e + 200; } +int *f() {} +main() { + g(a, c, b); + if (0) { + __goblint_check(0); // NOWARN (unreachable) + } + __goblint_check(1); // reachable +} +g(int, struct h *, struct i *) { + int *j = f(); + d(j); + __goblint_check(1); // reachable +} diff --git a/tests/regression/83-2cpo/29-widen.c b/tests/regression/83-2cpo/29-widen.c new file mode 100644 index 0000000000..a79f24619b --- /dev/null +++ b/tests/regression/83-2cpo/29-widen.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts + +int a; +long b, c, d, e, f, g, h; +int *i; +k() { + int j; + long top; + while (top) { + b = a * 424; + c = j; + d = j + b; + e = a * 424; + f = e + 8; + g = j; + h = j + f; + i = h; + a = a + 1; + __goblint_check(g == c); + // __goblint_check(h == 8 + d); + __goblint_check((long)i == h); + __goblint_check(j == c); + } +} +main() { k(); } From d139d80e39dabf8758d960e11769769fa9ea10b7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 18:21:09 +0200 Subject: [PATCH 205/323] simplified the jooin operation --- src/cdomains/c2poDomain.ml | 52 ++++++++++---------------------------- 1 file changed, 13 insertions(+), 39 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index d50f5dcdc0..68f962eddf 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -675,10 +675,7 @@ module CongruenceClosure = struct (** Add a term to the data structure. - Returns (reference variable, offset), updated (uf, set, map, min_repr), - and queue, that needs to be passed as a parameter to `update_min_repr`. - - `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. *) + Returns (reference variable, offset), updated congruence closure *) let rec insert cc t = if SSet.mem t cc.set then let v,z,uf = TUF.find cc.uf t in @@ -703,7 +700,7 @@ module CongruenceClosure = struct (** Add a term to the data structure. - Returns (reference variable, offset), updated (uf, set, map, min_repr) *) + Returns (reference variable, offset), updated congruence closure *) let insert cc t = match cc with | None -> (t, Z.zero), None @@ -926,40 +923,21 @@ module CongruenceClosure = struct List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) + (** Here we do the join without using the automata, because apparently + we don't want to describe the automaton in the paper...*) let join_eq cc1 cc2 = - let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in + let terms = SSet.union cc1.set cc2.set in + let cc1, cc2 = Option.get (insert_set (Some cc1) cc2.set), Option.get (insert_set (Some cc2) cc1.set) in let mappings = List.map (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in let r2, off2 = TUF.find_no_pc cc2.uf a in - (r1,r2,Z.(off2 - off1)), (a,off1)) atoms in - let add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) = + (r1,r2,Z.(off2 - off1)), (a,off1)) (SSet.to_list terms) in + let add_term (cc, pmap) (new_element, (new_term, a_off)) = match Map.find_opt new_element pmap with - | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs + | None -> cc, Map.add new_element (new_term, a_off) pmap | Some (c, c1_off) -> - pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in - let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some (init_cc []),[]) mappings in - (* add equalities that make sure that all atoms that have the same - representative are equal. *) - let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = - let a', a_off = TUF.find_no_pc cc1.uf a in - match LMap.map_find_opt (y, Z.(diff + offset)) cc2.map with - | None -> pmap,cc,new_pairs - | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in - match SSet.deref_term t Z.(offset - t1_off) cc1.set with - | exception (T.UnsupportedCilExpression _) -> pmap,cc,new_pairs - | new_term -> - let _ , cc = insert cc new_term in - let new_element = a',b',Z.(b_off - a_off) in - add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) - in - let rec add_edges_to_map pmap cc = function - | [] -> cc, pmap - | (x,y,diff)::rest -> - let t,t1_off = Map.find (x,y,diff) pmap in - let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off diff) (pmap, cc, []) (LMap.successors x cc1.map) in - add_edges_to_map pmap cc (rest@new_pairs) - in - add_edges_to_map pmap cc working_set + add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in + List.fold_left add_term (Some (init_cc []), Map.empty) mappings (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = @@ -1103,15 +1081,11 @@ module D = struct let name () = "c2po" - let equal x y = + let equal x y = (*TODO*) if x == y then true else - let res = match x, y with - | Some x, Some y -> - (T.props_equal (get_normal_form x) (get_normal_form y)) - | None, None -> true - | _ -> false + let res = true in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} From 1c59fc6ab67678f1f667408fb22cc3701b78475d Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 5 Jul 2024 19:02:33 +0200 Subject: [PATCH 206/323] I think I implemented the simplified restriction. I'll have to look at it again --- src/cdomains/c2poDomain.ml | 306 +++++++++++++++++++++++-------------- 1 file changed, 189 insertions(+), 117 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 68f962eddf..177587dcd9 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -357,6 +357,22 @@ module CongruenceClosure = struct let map_set_mem v v' (map:t) = match TMap.find_opt v map with | None -> false | Some set -> TSet.mem v' set + + let filter_if (map:t) p = + TMap.filter_map (fun _ t_set -> + let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) map + + let filter_map f (diseq:t) = + TMap.filter_map + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) diseq + + let shift v r v' (map:t) = + match TMap.find_opt v' map with + | None -> map + | Some tset -> + TMap.remove v' (TMap.add v tset map) end (** Set of subterms which are present in the current data structure. *) @@ -794,129 +810,186 @@ module CongruenceClosure = struct Some {cc with bldis} (* Remove variables: *) - - let remove_terms_from_eq predicate cc = - let rec insert_terms cc = - function | [] -> cc | t::ts -> insert_terms (snd (insert cc t)) ts in - (* start from all initial states that are still valid and find new representatives if necessary *) - (* new_reps maps each representative term to the new representative of the equivalence class *) - (*but new_reps contains an element but not necessarily the representative!!*) - let find_new_repr state old_rep old_z new_reps = - match LMap.find_opt old_rep new_reps with - | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps - | None -> if not @@ predicate old_rep then - old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) - (* the representative need to be removed from the data structure: state is the new repr.*) - state, Z.zero, TMap.add old_rep (state, old_z) new_reps in - let add_atom (new_reps, new_cc, reachable_old_reps) state = - let old_rep, old_z = TUF.find_no_pc cc.uf state in - let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in - let new_cc = insert_terms new_cc [state; new_rep] in - let new_cc = closure_no_min_repr new_cc [(state, new_rep, new_z)] in - (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) + let add_to_map_of_children value map term = + if T.equal term value then map else + match TMap.find_opt term map with + | None -> TMap.add term [value] map + | Some list -> TMap.add term (value::list) map + + let remove_from_map_of_children parent child map = + match List.remove_if (T.equal child) (TMap.find parent map) with + | [] -> TMap.remove parent map + | new_children -> TMap.add parent new_children map + + (** Parameters: + - `cc`: congruence closure data structure + - `predicate`: predicate that returns true for terms which need to be removed from the data structure. + It takes `uf` as a parameter. + Returns: + - `new_set`: subset of `set` which contains the terms that do not have to be removed. + - `removed_terms`: list of all elements of `set` which contains the terms that have to be removed. + - `map_of_children`: maps each element of union find to its children in the union find tree. It is used in order to later remove these elements from the union find data structure. + - `cc`: updated congruence closure data structure. + *) + let remove_terms_from_set cc predicate = + let rec remove_terms_recursive (new_set, removed_terms, map_of_children, cc) = function + | [] -> (new_set, removed_terms, map_of_children, cc) + | el::rest -> + let new_set, removed_terms = if predicate cc el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in + let uf_parent = TUF.parent cc.uf el in + let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in + (* in order to not lose information by removing some elements, we add dereferences values to the union find.*) + remove_terms_recursive (new_set, removed_terms, map_of_children, cc) rest in - let new_reps, new_cc, reachable_old_reps = - SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some(init_cc [])),[]) cc.set in - let cmap = Disequalities.comp_map cc.uf in - (* breadth-first search of reachable states *) - let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = - let old_rep_s, old_z_s = TUF.find_no_pc cc.uf s_t in - let find_successor_in_set (z, term_set) = - let exception Found in - let res = ref None in - try - TSet.iter (fun t -> - match SSet.deref_term t Z.(s_z-z) cc.set with - | exception (T.UnsupportedCilExpression _) -> () - | successor -> if (not @@ predicate successor) then - (res := Some successor; raise Found) - else - () - ) term_set; !res - with Found -> !res - in - (* find successor term -> find any element in equivalence class that can be dereferenced *) - match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with - | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then - let new_cc = insert_terms new_cc [successor_term] in - match LMap.find_opt old_rep_s new_reps with - | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) - new_reps, closure_no_min_repr new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps - | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. - -> we choose a successor term *(t+z) for any - -> we need add the successor state to the list of states that still need to be visited - *) - TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps - else - (new_reps, new_cc, reachable_old_reps) + (* TODO make this a fold *) + remove_terms_recursive (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) + + let show_map_of_children map_of_children = + List.fold_left + (fun s (v, list) -> + s ^ T.show v ^ "\t:\n" ^ + List.fold_left + (fun s v -> + s ^ T.show v ^ "; ") + "\t" list ^ "\n") + "" (TMap.bindings map_of_children) + + (** Removes all terms in "removed_terms" from the union find data structure. + Returns: + - `uf`: the updated union find tree + - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. + *) + let remove_terms_from_uf cc removed_terms map_of_children predicate = + let find_not_removed_element set = match List.find (fun el -> not (predicate cc el)) set with + | exception Not_found -> List.first set + | t -> t + in + let remove_term (uf, new_parents_map, map_of_children) t = + match LMap.find_opt t map_of_children with | None -> - (* the term cannot be dereferenced, so we won't add this transition. *) - (new_reps, new_cc, reachable_old_reps) + (* t has no children, so we can safely delete the element from the data structure *) + (* we just need to update the size on the whole path from here to the root *) + let new_parents_map = if TUF.is_root uf t then new_parents_map else LMap.add t (TUF.parent uf t) new_parents_map in + let parent = fst (TUF.parent uf t) in + let map_of_children = if TUF.is_root uf t then map_of_children else remove_from_map_of_children parent t map_of_children in + (TUF.ValMap.remove t (TUF.modify_size t uf pred), new_parents_map, map_of_children) + | Some children -> + let map_of_children = LMap.remove t map_of_children in + if TUF.is_root uf t then + (* t is a root and it has some children: + 1. choose new root. + The new_root is in any case one of the children of the old root. + If possible, we choose one of the children that is not going to be deleted. *) + let new_root = find_not_removed_element children in + let remaining_children = List.remove_if (T.equal new_root) children in + let offset_new_root = TUF.parent_offset uf new_root in + (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) + let new_size, map_of_children, uf = List.fold + (fun (total_size, map_of_children, uf) child -> + (* update parent and offset *) + let uf = TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf child - offset_new_root)) in + total_size + TUF.subtree_size uf child, add_to_map_of_children child map_of_children new_root, uf + ) (0, map_of_children, uf) remaining_children in + (* Update new root -> set itself as new parent. *) + let uf = TUF.modify_parent uf new_root (new_root, Z.zero) in + (* update size of equivalence class *) + let uf = TUF.modify_size new_root uf ((+) new_size) in + (TUF.ValMap.remove t uf, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) + else + (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) + let (new_root, new_offset) = TUF.parent uf t in + let remaining_children = List.remove_if (T.equal new_root) children in + (* update all parents of the children of t *) + let map_of_children, uf = List.fold + (fun (map_of_children, uf) child -> + (* update parent and offset *) + add_to_map_of_children child map_of_children new_root, + TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf t + new_offset)) + ) (map_of_children, uf) remaining_children in + (* update size of equivalence class *) + let uf = TUF.modify_size new_root uf pred in + (TUF.ValMap.remove t uf, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) in - (* find all successors that are still reachable *) - let rec add_transitions new_reps new_cc = function - | [] -> new_reps, new_cc - | (old_rep, new_rep, z)::rest -> - let successors = LMap.successors old_rep cc.map in - let new_reps, new_cc, reachable_old_reps = - List.fold (add_transition (old_rep, new_rep,z)) (new_reps, new_cc, []) successors in - add_transitions new_reps new_cc (rest@reachable_old_reps) - in add_transitions new_reps new_cc - (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) + List.fold_left remove_term (cc.uf, LMap.empty, map_of_children) removed_terms + let show_new_parents_map new_parents_map = List.fold_left + (fun s (v1, (v2, o2)) -> + s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") + "" (TMap.bindings new_parents_map) (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) - let find_new_root new_reps uf v = - match TMap.find_opt v new_reps with - | None -> None - | Some (new_t, z1) -> - let t_rep, z2 = TUF.find_no_pc uf new_t in - Some (t_rep, Z.(z2-z1)) - - let remove_terms_from_diseq diseq new_reps cc = - let disequalities = Disequalities.get_disequalities diseq - in - let add_disequality new_diseq = function - | Nequal(t1,t2,z) -> - begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with - | Some (t1',z1'), Some (t2', z2') -> (t1', t2', Z.(z2'+z-z1'))::new_diseq - | _ -> new_diseq - end - | _-> new_diseq - in - let new_diseq = List.fold add_disequality [] disequalities - in congruence_neq cc new_diseq - - let remove_terms_from_bldis bldis new_reps cc = - let disequalities = BlDis.to_conj bldis - in - let add_bl_dis new_diseq = function - | BlNequal (t1,t2) -> - begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with - | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq (t1', t2') - | _ -> new_diseq - end - | _-> new_diseq - in - List.fold add_bl_dis BlDis.empty disequalities + let rec find_new_root new_parents_map uf v = + match LMap.find_opt v new_parents_map with + | None -> TUF.find_opt uf v + | Some (new_parent, new_offset) -> + match find_new_root new_parents_map uf new_parent with + | None -> None + | Some (r, o, uf) -> Some (r, Z.(o + new_offset), uf) + + (** Removes all terms from the mapped values of this map, + for which "predicate" is false. *) + let remove_terms_from_mapped_values map predicate = + LMap.filter_if map (not % predicate) + + (** For all the elements in the removed terms set, it moves the mapped value to the new root. + Returns new map and new union-find. *) + let remove_terms_from_map (uf, map) removed_terms new_parents_map = + let remove_from_map (map, uf) term = + match LMap.find_opt term map with + | None -> map, uf + | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) + match find_new_root new_parents_map uf term with + | None -> LMap.remove term map, uf + | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term map, uf + in List.fold_left remove_from_map (map, uf) removed_terms + + let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms predicate new_parents_map uf = + (* modify mapped values + -> change terms to their new representatives or remove them, if the representative class was completely removed. *) + let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (Disequalities.filter_if diseq (not % predicate)) in + (* modify left hand side of map *) + let res, uf = remove_terms_from_map (uf, diseq) removed_terms new_parents_map in + if M.tracing then M.trace "wrpointer-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (Disequalities.show_neq res) (TUF.show_uf uf); res, uf + + let remove_terms_from_bldis (diseq: BlDis.t) removed_terms predicate new_parents_map uf = + (* modify mapped values + -> change terms to their new representatives or remove them, if the representative class was completely removed. *) + let diseq = BlDis.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (BlDis.filter_if diseq (not % predicate)) in + (* modify left hand side of map *) + let remove_terms_from_bldis (uf, map) removed_terms new_parents_map = + let remove_from_map (map, uf) term = + match LMap.find_opt term map with + | None -> map, uf + | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) + match find_new_root new_parents_map uf term with + | None -> LMap.remove term map, uf + | Some (new_root, new_offset, uf) -> BlDis.shift new_root new_offset term map, uf + in List.fold_left remove_from_map (map, uf) removed_terms in + let res, uf = remove_terms_from_bldis (uf, diseq) removed_terms new_parents_map in + if M.tracing then M.trace "wrpointer-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (show_conj(BlDis.to_conj res)) (TUF.show_uf uf); res, uf (** Remove terms from the data structure. It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = let old_cc = cc in - match remove_terms_from_eq predicate cc with - | new_reps, Some cc -> - begin match remove_terms_from_diseq old_cc.diseq new_reps cc with - | Some cc -> - let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" - (show_all old_cc) (show_all {cc with bldis}); - Some {cc with bldis} - | None -> None - end - | _,None -> None - + (* first find all terms that need to be removed *) + let set, removed_terms, map_of_children, cc = + remove_terms_from_set cc predicate + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + (show_all old_cc); + let uf, new_parents_map, _ = + remove_terms_from_uf cc removed_terms map_of_children predicate + in let map = + remove_terms_from_mapped_values cc.map (predicate cc) + in let map, uf = + remove_terms_from_map (uf, map) removed_terms new_parents_map + in let diseq, uf = + remove_terms_from_diseq cc.diseq removed_terms (predicate cc) new_parents_map uf + in let bldis, uf = remove_terms_from_bldis cc.bldis removed_terms (predicate cc) new_parents_map uf + in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + (show_all old_cc) (show_all {uf; set; map; diseq; bldis}); + {uf; set; map; diseq; bldis} (* join *) let show_pmap pmap= @@ -1152,14 +1225,14 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) + Option.map (remove_terms (fun cc t -> Var.equal (T.get_var t) var)) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (T.contains_variable vars)) + Option.map (remove_terms (fun cc -> T.contains_variable vars)) cc (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", @@ -1167,19 +1240,18 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) + Option.map (remove_terms (fun cc t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in - Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) + Option.map (remove_terms (fun cc t -> MayBeEqual.may_be_equal ask (Some cc) s term t)) cc (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) - + Option.map (remove_terms (fun cc t -> MayBeEqual.may_point_to_one_of_these_adresses ask address cc t)) cc end From e3c71e83299a5c24d89f3ecf37cd1ab9e967eccd Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 11:49:59 +0200 Subject: [PATCH 207/323] implemented equality for c2po --- src/cdomains/c2poDomain.ml | 55 +++++++++++++++++++++++++++++++++++--- 1 file changed, 52 insertions(+), 3 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 177587dcd9..1c97e1ccf5 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1038,6 +1038,50 @@ module CongruenceClosure = struct in (if M.tracing then M.trace "wrpointer-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); {cc with bldis} + (* check for equality *) + + (** Compares the equivalence classes of cc1 and those of cc2. *) + let equal_eq_classes cc1 cc2 = + (* add all terms to both elements *) + let cc1, cc2 = Option.get (insert_set (Some cc1) cc2.set), Option.get (insert_set (Some cc2) cc1.set) in + let comp1, comp2 = Disequalities.comp_map cc1.uf, Disequalities.comp_map cc2.uf in + (* they should have the same number of equivalence classes *) + if TMap.cardinal comp1 <> TMap.cardinal comp2 then false else + (* compare each equivalence class of cc1 with the corresponding eq. class of cc2 *) + let compare_zmap_entry offset zmap2 (z, tset1) = + match ZMap.find_opt Z.(z+offset) zmap2 with + | None -> false + | Some tset2 -> SSet.equal tset1 tset2 + in + let compare_with_cc2_eq_class (rep1, zmap1) = + let rep2, offset = TUF.find_no_pc cc2.uf rep1 in + let zmap2 = TMap.find rep2 comp2 in + List.for_all (compare_zmap_entry offset zmap2) (ZMap.bindings zmap1) + in + List.for_all compare_with_cc2_eq_class (TMap.bindings comp1) + + let equal_diseqs cc1 cc2 = + let rename_diseqs dis = match dis with + | Nequal (t1,t2,z) -> + let (min_state1, min_z1) = TUF.find_no_pc cc2.uf t1 in + let (min_state2, min_z2) = TUF.find_no_pc cc2.uf t2 in + let new_offset = Z.(-min_z2 + min_z1 + z) in + if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) + else Nequal (min_state2, min_state1, Z.(-new_offset)) + | _ -> dis in + let renamed_diseqs = List.map rename_diseqs (Disequalities.get_disequalities cc1.diseq) in + Set.equal (Set.of_list renamed_diseqs) (Set.of_list (Disequalities.get_disequalities cc2.diseq)) + + let equal_bldis cc1 cc2 = + let rename_bldis dis = match dis with + | BlNequal (t1,t2) -> + let min_state1, _ = TUF.find_no_pc cc2.uf t1 in + let min_state2, _ = TUF.find_no_pc cc2.uf t2 in + if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) + else BlNequal (min_state2, min_state1) + | _ -> dis in + let renamed_diseqs = List.map rename_bldis (BlDis.to_conj cc1.bldis) in + Set.equal (Set.of_list renamed_diseqs) (Set.of_list (BlDis.to_conj cc2.bldis)) end include CongruenceClosure @@ -1154,12 +1198,17 @@ module D = struct let name () = "c2po" - let equal x y = (*TODO*) + let equal x y = if x == y then true else - let res = true - in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + let res = + match x,y with + | None, None -> true + | Some cc1, Some cc2 -> + equal_eq_classes cc1 cc2 + | _ -> false + in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} From e64541b4e30bfec92d82bb3dcb0aaf6701aeb0fe Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 11:50:27 +0200 Subject: [PATCH 208/323] replaced wrpointer with c2po for the tracing --- src/analyses/c2poAnalysis.ml | 36 +++++++++++++-------------- src/cdomains/c2poDomain.ml | 48 ++++++++++++++++++------------------ 2 files changed, 42 insertions(+), 42 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index d8f0950cd6..7aea0df2f6 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -21,7 +21,7 @@ struct let reachable_from_args ctx args = let res = List.fold (fun vs e -> vs @ (ctx.ask (ReachableFrom e) |> Queries.AD.to_var_may)) [] args in - if M.tracing then M.tracel "wrpointer-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res + if M.tracing then M.tracel "c2po-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, @@ -33,11 +33,11 @@ struct | x::xs, _, [] -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None | _, y::ys, [] -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None | _ -> None (*there should never be block disequalities here...*) - in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" + in if M.tracing then M.trace "c2po" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res (* let query_may_point_to ctx t e = - if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" + if M.tracing then M.trace "c2po-query" "may-point-to %a!" d_exp e; match T.of_cil (ask_of_ctx ctx) e with | Some term, Some offset -> @@ -48,7 +48,7 @@ struct let valid_term (t,z) = T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); let intersect_query_result res (term,z) = let next_query = @@ -59,7 +59,7 @@ struct in MayBeEqual.AD.meet res next_query in List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms - in if M.tracing then M.trace "wrpointer-query" "may-point-to %a : %a. Is bot: %b\n" + in if M.tracing then M.trace "c2po-query" "may-point-to %a : %a. Is bot: %b\n" d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res end | _ -> @@ -88,7 +88,7 @@ struct (* Definite assignment *) | s, lterm, (Some term, Some offset) -> let dummy_var = MayBeEqual.dummy_var lval_t in - if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); + if M.tracing then M.trace "c2po-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> @@ -102,14 +102,14 @@ struct let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in - if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res + if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in let res = meet_conjs_opt valid_props ctx.local in if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" + if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" d_exp e pos (show_conj valid_props); res @@ -126,7 +126,7 @@ struct | Some e -> assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e | None -> ctx.local - in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res + in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res let add_new_block t ask lval = @@ -154,13 +154,13 @@ struct | None -> ctx.local | Some varin -> - if M.tracing then M.trace "wrpointer-malloc" + if M.tracing then M.trace "c2po-malloc" "SPECIAL MALLOC: exp = %a; var_opt = Some (%a); v = %a; " d_exp exp d_lval varin d_lval (Var v, NoOffset); add_new_block ctx.local (ask_of_ctx ctx) varin end | _ -> ctx.local - let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } + let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } (*First all local variables of the function are duplicated (by negating their ID), @@ -171,13 +171,13 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in - if M.tracing then M.trace "wrpointer-function" "ENTER2: result: %s\n" (D.show new_state); + if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); [ctx.local, new_state] (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t @@ -191,25 +191,25 @@ struct (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = (* find out the tainted variables from startState *) ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) in - if M.tracing then M.trace "wrpointer-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; + if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; let local = D.remove_tainted_terms ask tainted state_with_assignments in let t = D.meet local t in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in let t = D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t - in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t + in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t let startstate v = D.top () let threadenter ctx ~multiple lval f args = [D.top ()] diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 1c97e1ccf5..d05231766b 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -487,7 +487,7 @@ module CongruenceClosure = struct if T.compare t1 t2 < 0 then Nequal (t1, t2, z) else Nequal (t2, t1, Z.(-z)) in - if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); + if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in (* block disequalities *) let normalize_bldis t = match t with @@ -549,7 +549,7 @@ module CongruenceClosure = struct (* taking explicit dis-equalities into account *) let neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in - if M.tracing then M.trace "wrpointer-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); + if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); Some {uf; set=cc.set; map=cc.map; diseq=neq; bldis=cc.bldis} with Unsat -> None @@ -576,7 +576,7 @@ module CongruenceClosure = struct let v2, r2, uf = TUF.find uf t2 in let sizet1, sizet2 = T.get_size t1, T.get_size t2 in if not (Z.equal sizet1 sizet2) then - (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); + (if M.tracing then M.trace "c2po" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); closure (uf, map, new_repr) rest) else if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) @@ -782,7 +782,7 @@ module CongruenceClosure = struct let meet_conjs cc pos_conjs = let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in closure cc pos_conjs - in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res + in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs, bl_conjs = split conjs in @@ -949,7 +949,7 @@ module CongruenceClosure = struct let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (Disequalities.filter_if diseq (not % predicate)) in (* modify left hand side of map *) let res, uf = remove_terms_from_map (uf, diseq) removed_terms new_parents_map in - if M.tracing then M.trace "wrpointer-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (Disequalities.show_neq res) (TUF.show_uf uf); res, uf + if M.tracing then M.trace "c2po-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (Disequalities.show_neq res) (TUF.show_uf uf); res, uf let remove_terms_from_bldis (diseq: BlDis.t) removed_terms predicate new_parents_map uf = (* modify mapped values @@ -966,7 +966,7 @@ module CongruenceClosure = struct | Some (new_root, new_offset, uf) -> BlDis.shift new_root new_offset term map, uf in List.fold_left remove_from_map (map, uf) removed_terms in let res, uf = remove_terms_from_bldis (uf, diseq) removed_terms new_parents_map in - if M.tracing then M.trace "wrpointer-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (show_conj(BlDis.to_conj res)) (TUF.show_uf uf); res, uf + if M.tracing then M.trace "c2po-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (show_conj(BlDis.to_conj res)) (TUF.show_uf uf); res, uf (** Remove terms from the data structure. It removes all terms for which "predicate" is false, @@ -976,7 +976,7 @@ module CongruenceClosure = struct (* first find all terms that need to be removed *) let set, removed_terms, map_of_children, cc = remove_terms_from_set cc predicate - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + in if M.tracing then M.trace "c2po" "REMOVE TERMS: %s\n BEFORE: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) (show_all old_cc); let uf, new_parents_map, _ = remove_terms_from_uf cc removed_terms map_of_children predicate @@ -987,7 +987,7 @@ module CongruenceClosure = struct in let diseq, uf = remove_terms_from_diseq cc.diseq removed_terms (predicate cc) new_parents_map uf in let bldis, uf = remove_terms_from_bldis cc.bldis removed_terms (predicate cc) new_parents_map uf - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) + in if M.tracing then M.trace "c2po" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) (show_all old_cc) (show_all {uf; set; map; diseq; bldis}); {uf; set; map; diseq; bldis} (* join *) @@ -1022,7 +1022,7 @@ module CongruenceClosure = struct let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2) in let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in let res = congruence_neq cc (diseq1 @ diseq2) - in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res + in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. *) let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = @@ -1035,7 +1035,7 @@ module CongruenceClosure = struct let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms - in (if M.tracing then M.trace "wrpointer-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); + in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); {cc with bldis} (* check for equality *) @@ -1090,11 +1090,11 @@ include CongruenceClosure module MayBeEqual = struct module AD = Queries.AD - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="c2po__@return"} let return_var var = T.aux_term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) @@ -1108,7 +1108,7 @@ module MayBeEqual = struct let valid_term (t,z) = T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); let intersect_query_result res (term,z) = let next_query = @@ -1127,7 +1127,7 @@ module MayBeEqual = struct let mpt1 = adresses in let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + if M.tracing then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = @@ -1135,7 +1135,7 @@ module MayBeEqual = struct let exp1 = T.to_cil t1 in let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in let res = may_point_to_address ask mpt1 t2 off cc in - if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" + if M.tracing && res then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" AD.pretty mpt1 (T.show t1) d_plainexp exp1; res let rec may_be_equal ask cc s t1 t2 = @@ -1166,7 +1166,7 @@ module MayBeEqual = struct | None -> false | Some cc -> let res = (may_be_equal ask cc s t1 t2) in - if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + if M.tracing then M.tracel "c2po-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res let rec may_point_to_one_of_these_adresses ask adresses cc t2 = @@ -1229,18 +1229,18 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> - if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); let cc = fst(join_eq a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) in - if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" + if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); res - let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b + let widen a b = if M.tracing then M.trace "c2po-join" "WIDEN\n";join a b let meet a b = if a == b then @@ -1273,14 +1273,14 @@ module D = struct It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); + if M.tracing then M.trace "c2po" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); Option.map (remove_terms (fun cc t -> Var.equal (T.get_var t) var)) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + if M.tracing then M.trace "c2po" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.map (remove_terms (fun cc -> T.contains_variable vars)) cc (** Remove terms from the data structure. @@ -1288,19 +1288,19 @@ module D = struct except the global vars are also keeped (when vstorage = static), while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.map (remove_terms (fun cc t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = - if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); + if M.tracing then M.trace "c2po" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in Option.map (remove_terms (fun cc t -> MayBeEqual.may_be_equal ask (Some cc) s term t)) cc (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = - if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; + if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; Option.map (remove_terms (fun cc t -> MayBeEqual.may_point_to_one_of_these_adresses ask address cc t)) cc end From 9ace51b852f8cf170ed659cd7e1b6603d1b1afaf Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 11:50:57 +0200 Subject: [PATCH 209/323] updated tests for c2po --- tests/regression/83-2cpo/18-complicated-join.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/83-2cpo/18-complicated-join.c b/tests/regression/83-2cpo/18-complicated-join.c index 75e212752e..0e0515768a 100644 --- a/tests/regression/83-2cpo/18-complicated-join.c +++ b/tests/regression/83-2cpo/18-complicated-join.c @@ -20,5 +20,5 @@ void main(void) { __goblint_check(******y == (long **)y); } // This does not work any more because the analysis is not precise enough - // __goblint_check(******y == (long**)y); + __goblint_check(******y == (long **)y); // UNKNOWN } From f89d0b235a1115b9d825dffc4167a6c23e185be4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 11:52:00 +0200 Subject: [PATCH 210/323] added conf file for c2po --- conf/svcomp-c2po.json | 148 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 148 insertions(+) create mode 100644 conf/svcomp-c2po.json diff --git a/conf/svcomp-c2po.json b/conf/svcomp-c2po.json new file mode 100644 index 0000000000..7549412730 --- /dev/null +++ b/conf/svcomp-c2po.json @@ -0,0 +1,148 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "symb_locks", + "region", + "thread", + "threadJoins", + "c2po", + "startState", + "taintPartialContexts" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": true, + "id": "enumerate", + "unknown": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "invariant_set" + ], + "invariant-types": [ + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": false, + "other": false, + "accessed": false, + "exact": true, + "exclude-vars": [ + "tmp\\(___[0-9]+\\)?", + "cond", + "RETURN", + "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", + ".*____CPAchecker_TMP_[0-9]+", + "__VERIFIER_assert__cond", + "__ksymtab_.*", + "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" + ] + } + }, + "pre": { + "enabled": false + } + } From 9e3ad40f20558e4beddb42738d95740046c60c92 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 13:02:18 +0200 Subject: [PATCH 211/323] update comments and make some order --- src/analyses/c2poAnalysis.ml | 2 +- src/cdomains/c2poDomain.ml | 175 ++++++++++++++++++++--------------- 2 files changed, 100 insertions(+), 77 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 7aea0df2f6..73dd126ff4 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -136,7 +136,7 @@ struct (* Indefinite assignment *) | s, lterm -> (* let t = D.remove_may_equal_terms ask s lterm t in - -> not necessary because this is always a new fresh variable in goblint *) + -> not necessary because lterm is always a new fresh variable in goblint *) add_block_diseqs t lterm (* Definite assignment *) | exception (T.UnsupportedCilExpression _) -> D.top () diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index d05231766b..6428127b0f 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -127,6 +127,9 @@ module CongruenceClosure = struct list@list2 ) [] (ZMap.bindings imap) + (** Find all disequalities of the form t1 != z2-z1 + t2 + that can be inferred from equalities of the form *(z1 + t1) = *(z2 + t2). + *) let check_neq (_,arg) rest (v,zmap) = let zlist = ZMap.bindings zmap in fold_left2 (fun rest (r1,_) (r2,_) -> @@ -146,18 +149,21 @@ module CongruenceClosure = struct else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 ) rest zlist zlist + (** Find all disequalities of the form t1 != z2-z1 + t2 + that can be inferred from block equalities of the form bl( *(z1 + t1) ) = bl( *(z2 + t2) ). + *) let check_neq_bl (uf,arg) rest (t1, tset) = List.fold (fun rest t2 -> - if T.equal (fst@@TUF.find_no_pc_if_possible uf t1) (fst@@TUF.find_no_pc_if_possible uf t2) - then raise Unsat - else (* r1 <> r2 *) - let l1 = map_find_all t1 arg in - let l2 = map_find_all t2 arg in - fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if T.equal v1 v2 then if Z.equal r'1 r'2 - then raise Unsat - else rest - else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 + (* if T.equal (fst@@TUF.find_no_pc_if_possible uf t1) (fst@@TUF.find_no_pc_if_possible uf t2) + then raise Unsat + else*) (* r1 <> r2 *) + let l1 = map_find_all t1 arg in + let l2 = map_find_all t2 arg in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if T.equal v1 v2 then if Z.equal r'1 r'2 + then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 ) rest (TSet.to_list tset) (** Initialize the list of disequalities taking only implicit dis-equalities into account. @@ -227,6 +233,7 @@ module CongruenceClosure = struct (* collection of disequalities: * disequalities originating from different offsets of same root + * disequalities originating from block disequalities * stated disequalities * closure by collecting appropriate args for a disequality v1 != v2 +r for distinct roots v1,v2 @@ -272,6 +279,10 @@ module CongruenceClosure = struct Nequal (t1,t2,Z.(-z)) ) % bindings + (** For each disequality t1 != z + t2 we add all disequalities + that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', + then we add the disequaity t1' != z + z2 - z1 + t2'. + *) let element_closure diseqs cmap = let comp_closure (r1,r2,z) = let to_tuple_list = (*TODO this is not the best solution*) @@ -296,7 +307,12 @@ module CongruenceClosure = struct (* block disequalities *) module BlDis = struct - type t = TSet.t TMap.t [@@deriving eq, ord, hash] (* block disequalitites *) + (** Block disequalities: + a term t1 is mapped to a set of terms that have a different block than t1. + It is allowed to contain terms that are not present in the data structure, + so we shouldn't assume that all terms in bldis are present in the union find! + *) + type t = TSet.t TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings let empty = TMap.empty @@ -311,28 +327,27 @@ module CongruenceClosure = struct | None -> TMap.add t1 (TSet.singleton t2) bldiseq | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq + (** Add disequalities bl(t1) != bl(t2) and bl(t2) != bl(t1). *) let add_block_diseq bldiseq (t1, t2) = add (add bldiseq t1 t2) t2 t1 (** params: - t1-> any term + t1-> a term that is NOT present in the data structure tlist: a list of representative terms - For each term t2 in tlist, it adds the disequality t1' != t2 to diseqs - where t1' is the representative of t1. - Except the block disequality t1' = t1' will not be added, even - if t1' is in tlist. + For each term t2 in tlist, it adds the disequality t1 != t2 to diseqs. *) let add_block_diseqs bldiseq uf t1 tlist = - let t1',_ = t1, t1 in - (* TODO: not a good idea: TUF.find_no_pc uf t1 in *) List.fold (fun bldiseq t2 -> - if T.equal t1' t2 then bldiseq - else add_block_diseq bldiseq (t1', t2)) bldiseq tlist + add_block_diseq bldiseq (t1, t2)) bldiseq tlist + (** For each block disequality bl(t1) != bl(t2) we add all disequalities + that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', + then we add the disequaity bl(t1') != bl(t2'). + *) let element_closure bldis cmap = let comp_closure = function | BlNequal (r1,r2) -> @@ -375,7 +390,8 @@ module CongruenceClosure = struct TMap.remove v' (TMap.add v tset map) end - (** Set of subterms which are present in the current data structure. *) + (** Set of subterms which are present in the current data structure. + TODO: check if it is needed? Because this information is implicitly present in the union find data structure. *) module SSet = struct type t = TSet.t [@@deriving eq, ord, hash] @@ -427,6 +443,11 @@ module CongruenceClosure = struct | None -> Deref (t, z, T.dereference_exp exp z) | Some t -> t + (** Sometimes it's important to keep the dereferenced term, + even if it's not technically possible to dereference it from a point of view of the C types. + We still need the dereferenced term for he correctness of some algorithms, + and the resulting expression will never be used, so it doesn't need to be a + C expression hat makes sense. *) let deref_term_even_if_its_not_possible min_term z set = match deref_term min_term z set with | result -> result @@ -462,8 +483,8 @@ module CongruenceClosure = struct (LMap.bindings map) (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) - Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) - (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) + Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) + (** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = let normalize_equality (t1, t2, z) = if T.equal t1 t2 && Z.(equal z zero) then None else @@ -554,18 +575,16 @@ module CongruenceClosure = struct with Unsat -> None (** - parameters: (uf, map) equalities. + parameters: (uf, map, new_repr) equalities. - returns updated (uf, map, queue), where: + returns updated (uf, map, new_repr), where: `uf` is the new union find data structure after having added all equalities. `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - `queue` is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. - It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map. - - `new_repr` -> maps each representative to its new representative after the union + `new_repr` maps each term that changed its representative term to the new representative. + It can be given as a parameter to `update_bldis` in order to update the representatives in the block disequalities. Throws "Unsat" if a contradiction is found. *) @@ -618,8 +637,8 @@ module CongruenceClosure = struct closure (uf, map, new_repr) rest ) + (** Update block disequalities with the new representatives, *) let update_bldis new_repr bldis = - (* update block disequalities with the new representatives *) let find_new_root t1 = match TMap.find_opt t1 new_repr with | None -> t1 | Some v -> v @@ -627,31 +646,11 @@ module CongruenceClosure = struct let disequalities = BlDis.to_conj bldis in (*TODO maybe optimize?, and maybe use this also for removing terms *) let add_bl_dis new_diseq = function - | BlNequal (t1,t2) ->BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) + | BlNequal (t1,t2) -> BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) | _-> new_diseq in List.fold add_bl_dis BlDis.empty disequalities - let rec add_normalized_bl_diseqs cc = function - | [] -> cc - | (t1,t2)::bl_conjs -> - match cc with - | None -> None - | Some cc -> - let t1' = fst (TUF.find_no_pc cc.uf t1) in - let t2' = fst (TUF.find_no_pc cc.uf t2) in - if T.equal t1' t2' then None (*unsatisfiable*) - else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in - add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs - - let closure_no_min_repr cc conjs = - match cc with - | None -> None - | Some cc -> - let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in - let bldis = update_bldis new_repr cc.bldis in - congruence_neq {uf; set = cc.set; map; diseq=cc.diseq; bldis=bldis} [] - (** Parameters: cc conjunctions. @@ -663,7 +662,9 @@ module CongruenceClosure = struct - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - - `min_repr` maps each equivalence class to its minimal representative. + - `diseq` are the disequalities between the new representatives. + + - `bldis` are the block disequalities between the new representatives. Throws "Unsat" if a contradiction is found. *) @@ -675,6 +676,22 @@ module CongruenceClosure = struct let bldis = update_bldis new_repr cc.bldis in congruence_neq {uf; set = cc.set; map; diseq=cc.diseq; bldis=bldis} [] + (** Adds the block disequalities to the cc, but first rewrites them such that + they are disequalities between representatives. The cc should already contain + all the terms that are present in those block disequalities. + *) + let rec add_normalized_bl_diseqs cc = function + | [] -> cc + | (t1,t2)::bl_conjs -> + match cc with + | None -> None + | Some cc -> + let t1' = fst (TUF.find_no_pc cc.uf t1) in + let t2' = fst (TUF.find_no_pc cc.uf t2) in + if T.equal t1' t2' then None (*unsatisfiable*) + else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in + add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs + (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = let cc = init_cc conj in @@ -724,7 +741,7 @@ module CongruenceClosure = struct (** Add all terms in a specific set to the data structure. - Returns updated (uf, set, map, min_repr). *) + Returns updated cc. *) let insert_set cc t_set = SSet.fold (fun t cc -> snd (insert cc t)) t_set cc @@ -749,15 +766,13 @@ module CongruenceClosure = struct | None -> false | Some cc -> fst (eq_query cc (t1,t2,r)) - (*TODO there could be less code duplication *) let block_neq_query cc (t1,t2) = (* we implicitly assume that &x != &y + z *) - if T.is_addr t1 && T.is_addr t2 then true else - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - match cc with - | None -> true - | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + match cc with + | None -> true + | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = @@ -784,6 +799,8 @@ module CongruenceClosure = struct closure cc pos_conjs in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res + (** Adds propositions to the data structure. + Returns None if a contradiction is found. *) let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs, bl_conjs = split conjs in let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in @@ -801,7 +818,7 @@ module CongruenceClosure = struct cc (** adds block disequalities to cc: - fo each representative t in cc it adds the disequality bl(lterm)!=bl(t)*) + fo each representative t in cc it adds the disequality bl(lterm) != bl(t)*) let add_block_diseqs cc lterm = match cc with | None -> cc @@ -810,6 +827,7 @@ module CongruenceClosure = struct Some {cc with bldis} (* Remove variables: *) + let add_to_map_of_children value map term = if T.equal term value then map else match TMap.find_opt term map with @@ -821,7 +839,7 @@ module CongruenceClosure = struct | [] -> TMap.remove parent map | new_children -> TMap.add parent new_children map - (** Parameters: + (** Variables: - `cc`: congruence closure data structure - `predicate`: predicate that returns true for terms which need to be removed from the data structure. It takes `uf` as a parameter. @@ -832,17 +850,14 @@ module CongruenceClosure = struct - `cc`: updated congruence closure data structure. *) let remove_terms_from_set cc predicate = - let rec remove_terms_recursive (new_set, removed_terms, map_of_children, cc) = function - | [] -> (new_set, removed_terms, map_of_children, cc) - | el::rest -> - let new_set, removed_terms = if predicate cc el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in - let uf_parent = TUF.parent cc.uf el in - let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in - (* in order to not lose information by removing some elements, we add dereferences values to the union find.*) - remove_terms_recursive (new_set, removed_terms, map_of_children, cc) rest + let remove_term (new_set, removed_terms, map_of_children, cc) el = + let new_set, removed_terms = + if predicate cc el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in + let uf_parent = TUF.parent cc.uf el in + let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in + (new_set, removed_terms, map_of_children, cc) in - (* TODO make this a fold *) - remove_terms_recursive (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) + List.fold remove_term (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) let show_map_of_children map_of_children = List.fold_left @@ -997,7 +1012,11 @@ module CongruenceClosure = struct s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) (** Here we do the join without using the automata, because apparently - we don't want to describe the automaton in the paper...*) + we don't want to describe the automaton in the paper... + + We construct a new cc that contains the elements of cc1.set U cc2.set + and two elements are in the same equivalence class iff they are in the same eq. class + both in cc1 and in cc2. *) let join_eq cc1 cc2 = let terms = SSet.union cc1.set cc2.set in let cc1, cc2 = Option.get (insert_set (Some cc1) cc2.set), Option.get (insert_set (Some cc2) cc1.set) in @@ -1012,7 +1031,9 @@ module CongruenceClosure = struct add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in List.fold_left add_term (Some (init_cc []), Map.empty) mappings - (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) + (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. + + This is done by checking for each disequality if it is implied by both cc. *) let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = let _,diseq1,_ = split (Disequalities.get_disequalities diseq1) in let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in @@ -1024,7 +1045,9 @@ module CongruenceClosure = struct let res = congruence_neq cc (diseq1 @ diseq2) in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res - (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. *) + (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. + + This is done by checing for each block disequality if it is implied by both cc. *) let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = let bldiseq1 = BlDis.to_conj bldiseq1 in let bldiseq2 = BlDis.to_conj bldiseq2 in @@ -1038,7 +1061,7 @@ module CongruenceClosure = struct in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); {cc with bldis} - (* check for equality *) + (* check for equality of two congruence closures *) (** Compares the equivalence classes of cc1 and those of cc2. *) let equal_eq_classes cc1 cc2 = From 55f7d5fdf65ee9863b2f84983613066cd788f688 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 15:50:05 +0200 Subject: [PATCH 212/323] fixed name of test folder --- tests/regression/{83-2cpo => 83-c2po}/01-simple.c | 0 tests/regression/{83-2cpo => 83-c2po}/02-rel-simple.c | 0 tests/regression/{83-2cpo => 83-c2po}/03-function-call.c | 0 tests/regression/{83-2cpo => 83-c2po}/04-remove-vars.c | 0 tests/regression/{83-2cpo => 83-c2po}/05-branch.c | 0 tests/regression/{83-2cpo => 83-c2po}/06-invertible-assignment.c | 0 tests/regression/{83-2cpo => 83-c2po}/07-invertible-assignment2.c | 0 tests/regression/{83-2cpo => 83-c2po}/08-simple-assignment.c | 0 tests/regression/{83-2cpo => 83-c2po}/09-different-offsets.c | 0 tests/regression/{83-2cpo => 83-c2po}/10-different-types.c | 0 tests/regression/{83-2cpo => 83-c2po}/11-array.c | 0 tests/regression/{83-2cpo => 83-c2po}/12-rel-function.c | 0 tests/regression/{83-2cpo => 83-c2po}/13-experiments.c | 0 tests/regression/{83-2cpo => 83-c2po}/14-join.c | 0 tests/regression/{83-2cpo => 83-c2po}/15-arrays-structs.c | 0 tests/regression/{83-2cpo => 83-c2po}/16-loops.c | 0 tests/regression/{83-2cpo => 83-c2po}/17-join2.c | 0 tests/regression/{83-2cpo => 83-c2po}/18-complicated-join.c | 0 tests/regression/{83-2cpo => 83-c2po}/19-disequalities.c | 0 tests/regression/{83-2cpo => 83-c2po}/20-self-pointing-struct.c | 0 tests/regression/{83-2cpo => 83-c2po}/21-global-var.c | 0 tests/regression/{83-2cpo => 83-c2po}/22-join-diseq.c | 0 tests/regression/{83-2cpo => 83-c2po}/23-function-deref.c | 0 .../{83-2cpo => 83-c2po}/24-disequalities-small-example.c | 0 tests/regression/{83-2cpo => 83-c2po}/25-struct-circular.c | 0 tests/regression/{83-2cpo => 83-c2po}/26-join3.c | 0 tests/regression/{83-2cpo => 83-c2po}/27-join-diseq2.c | 0 tests/regression/{83-2cpo => 83-c2po}/28-return-value.c | 0 tests/regression/{83-2cpo => 83-c2po}/29-widen.c | 0 29 files changed, 0 insertions(+), 0 deletions(-) rename tests/regression/{83-2cpo => 83-c2po}/01-simple.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/02-rel-simple.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/03-function-call.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/04-remove-vars.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/05-branch.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/06-invertible-assignment.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/07-invertible-assignment2.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/08-simple-assignment.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/09-different-offsets.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/10-different-types.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/11-array.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/12-rel-function.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/13-experiments.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/14-join.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/15-arrays-structs.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/16-loops.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/17-join2.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/18-complicated-join.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/19-disequalities.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/20-self-pointing-struct.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/21-global-var.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/22-join-diseq.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/23-function-deref.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/24-disequalities-small-example.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/25-struct-circular.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/26-join3.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/27-join-diseq2.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/28-return-value.c (100%) rename tests/regression/{83-2cpo => 83-c2po}/29-widen.c (100%) diff --git a/tests/regression/83-2cpo/01-simple.c b/tests/regression/83-c2po/01-simple.c similarity index 100% rename from tests/regression/83-2cpo/01-simple.c rename to tests/regression/83-c2po/01-simple.c diff --git a/tests/regression/83-2cpo/02-rel-simple.c b/tests/regression/83-c2po/02-rel-simple.c similarity index 100% rename from tests/regression/83-2cpo/02-rel-simple.c rename to tests/regression/83-c2po/02-rel-simple.c diff --git a/tests/regression/83-2cpo/03-function-call.c b/tests/regression/83-c2po/03-function-call.c similarity index 100% rename from tests/regression/83-2cpo/03-function-call.c rename to tests/regression/83-c2po/03-function-call.c diff --git a/tests/regression/83-2cpo/04-remove-vars.c b/tests/regression/83-c2po/04-remove-vars.c similarity index 100% rename from tests/regression/83-2cpo/04-remove-vars.c rename to tests/regression/83-c2po/04-remove-vars.c diff --git a/tests/regression/83-2cpo/05-branch.c b/tests/regression/83-c2po/05-branch.c similarity index 100% rename from tests/regression/83-2cpo/05-branch.c rename to tests/regression/83-c2po/05-branch.c diff --git a/tests/regression/83-2cpo/06-invertible-assignment.c b/tests/regression/83-c2po/06-invertible-assignment.c similarity index 100% rename from tests/regression/83-2cpo/06-invertible-assignment.c rename to tests/regression/83-c2po/06-invertible-assignment.c diff --git a/tests/regression/83-2cpo/07-invertible-assignment2.c b/tests/regression/83-c2po/07-invertible-assignment2.c similarity index 100% rename from tests/regression/83-2cpo/07-invertible-assignment2.c rename to tests/regression/83-c2po/07-invertible-assignment2.c diff --git a/tests/regression/83-2cpo/08-simple-assignment.c b/tests/regression/83-c2po/08-simple-assignment.c similarity index 100% rename from tests/regression/83-2cpo/08-simple-assignment.c rename to tests/regression/83-c2po/08-simple-assignment.c diff --git a/tests/regression/83-2cpo/09-different-offsets.c b/tests/regression/83-c2po/09-different-offsets.c similarity index 100% rename from tests/regression/83-2cpo/09-different-offsets.c rename to tests/regression/83-c2po/09-different-offsets.c diff --git a/tests/regression/83-2cpo/10-different-types.c b/tests/regression/83-c2po/10-different-types.c similarity index 100% rename from tests/regression/83-2cpo/10-different-types.c rename to tests/regression/83-c2po/10-different-types.c diff --git a/tests/regression/83-2cpo/11-array.c b/tests/regression/83-c2po/11-array.c similarity index 100% rename from tests/regression/83-2cpo/11-array.c rename to tests/regression/83-c2po/11-array.c diff --git a/tests/regression/83-2cpo/12-rel-function.c b/tests/regression/83-c2po/12-rel-function.c similarity index 100% rename from tests/regression/83-2cpo/12-rel-function.c rename to tests/regression/83-c2po/12-rel-function.c diff --git a/tests/regression/83-2cpo/13-experiments.c b/tests/regression/83-c2po/13-experiments.c similarity index 100% rename from tests/regression/83-2cpo/13-experiments.c rename to tests/regression/83-c2po/13-experiments.c diff --git a/tests/regression/83-2cpo/14-join.c b/tests/regression/83-c2po/14-join.c similarity index 100% rename from tests/regression/83-2cpo/14-join.c rename to tests/regression/83-c2po/14-join.c diff --git a/tests/regression/83-2cpo/15-arrays-structs.c b/tests/regression/83-c2po/15-arrays-structs.c similarity index 100% rename from tests/regression/83-2cpo/15-arrays-structs.c rename to tests/regression/83-c2po/15-arrays-structs.c diff --git a/tests/regression/83-2cpo/16-loops.c b/tests/regression/83-c2po/16-loops.c similarity index 100% rename from tests/regression/83-2cpo/16-loops.c rename to tests/regression/83-c2po/16-loops.c diff --git a/tests/regression/83-2cpo/17-join2.c b/tests/regression/83-c2po/17-join2.c similarity index 100% rename from tests/regression/83-2cpo/17-join2.c rename to tests/regression/83-c2po/17-join2.c diff --git a/tests/regression/83-2cpo/18-complicated-join.c b/tests/regression/83-c2po/18-complicated-join.c similarity index 100% rename from tests/regression/83-2cpo/18-complicated-join.c rename to tests/regression/83-c2po/18-complicated-join.c diff --git a/tests/regression/83-2cpo/19-disequalities.c b/tests/regression/83-c2po/19-disequalities.c similarity index 100% rename from tests/regression/83-2cpo/19-disequalities.c rename to tests/regression/83-c2po/19-disequalities.c diff --git a/tests/regression/83-2cpo/20-self-pointing-struct.c b/tests/regression/83-c2po/20-self-pointing-struct.c similarity index 100% rename from tests/regression/83-2cpo/20-self-pointing-struct.c rename to tests/regression/83-c2po/20-self-pointing-struct.c diff --git a/tests/regression/83-2cpo/21-global-var.c b/tests/regression/83-c2po/21-global-var.c similarity index 100% rename from tests/regression/83-2cpo/21-global-var.c rename to tests/regression/83-c2po/21-global-var.c diff --git a/tests/regression/83-2cpo/22-join-diseq.c b/tests/regression/83-c2po/22-join-diseq.c similarity index 100% rename from tests/regression/83-2cpo/22-join-diseq.c rename to tests/regression/83-c2po/22-join-diseq.c diff --git a/tests/regression/83-2cpo/23-function-deref.c b/tests/regression/83-c2po/23-function-deref.c similarity index 100% rename from tests/regression/83-2cpo/23-function-deref.c rename to tests/regression/83-c2po/23-function-deref.c diff --git a/tests/regression/83-2cpo/24-disequalities-small-example.c b/tests/regression/83-c2po/24-disequalities-small-example.c similarity index 100% rename from tests/regression/83-2cpo/24-disequalities-small-example.c rename to tests/regression/83-c2po/24-disequalities-small-example.c diff --git a/tests/regression/83-2cpo/25-struct-circular.c b/tests/regression/83-c2po/25-struct-circular.c similarity index 100% rename from tests/regression/83-2cpo/25-struct-circular.c rename to tests/regression/83-c2po/25-struct-circular.c diff --git a/tests/regression/83-2cpo/26-join3.c b/tests/regression/83-c2po/26-join3.c similarity index 100% rename from tests/regression/83-2cpo/26-join3.c rename to tests/regression/83-c2po/26-join3.c diff --git a/tests/regression/83-2cpo/27-join-diseq2.c b/tests/regression/83-c2po/27-join-diseq2.c similarity index 100% rename from tests/regression/83-2cpo/27-join-diseq2.c rename to tests/regression/83-c2po/27-join-diseq2.c diff --git a/tests/regression/83-2cpo/28-return-value.c b/tests/regression/83-c2po/28-return-value.c similarity index 100% rename from tests/regression/83-2cpo/28-return-value.c rename to tests/regression/83-c2po/28-return-value.c diff --git a/tests/regression/83-2cpo/29-widen.c b/tests/regression/83-c2po/29-widen.c similarity index 100% rename from tests/regression/83-2cpo/29-widen.c rename to tests/regression/83-c2po/29-widen.c From e251e1991aaf7dc38f6147e4d4df787cebc63af6 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 16:43:21 +0200 Subject: [PATCH 213/323] make it configurable if we want to use maypointto for c2po or not. Update regression tests by setting this to false for the tests that work also without maypointto. Also added conf file for c2po without maypointto --- conf/svcomp-c2po-no-maypointto.json | 151 ++++++++++++++++++ src/cdomains/c2poDomain.ml | 3 +- src/config/options.schema.json | 13 ++ tests/regression/83-c2po/03-function-call.c | 2 +- .../83-c2po/07-invertible-assignment2.c | 2 +- .../regression/83-c2po/09-different-offsets.c | 2 +- tests/regression/83-c2po/10-different-types.c | 2 +- tests/regression/83-c2po/13-experiments.c | 2 +- tests/regression/83-c2po/14-join.c | 2 +- tests/regression/83-c2po/15-arrays-structs.c | 2 +- tests/regression/83-c2po/16-loops.c | 2 +- .../regression/83-c2po/18-complicated-join.c | 2 +- tests/regression/83-c2po/19-disequalities.c | 2 +- .../83-c2po/20-self-pointing-struct.c | 2 +- tests/regression/83-c2po/22-join-diseq.c | 2 +- tests/regression/83-c2po/23-function-deref.c | 2 +- .../83-c2po/24-disequalities-small-example.c | 2 +- tests/regression/83-c2po/25-struct-circular.c | 2 +- tests/regression/83-c2po/26-join3.c | 2 +- tests/regression/83-c2po/27-join-diseq2.c | 2 +- tests/regression/83-c2po/28-return-value.c | 2 +- tests/regression/83-c2po/29-widen.c | 2 +- 22 files changed, 185 insertions(+), 20 deletions(-) create mode 100644 conf/svcomp-c2po-no-maypointto.json diff --git a/conf/svcomp-c2po-no-maypointto.json b/conf/svcomp-c2po-no-maypointto.json new file mode 100644 index 0000000000..12bb959960 --- /dev/null +++ b/conf/svcomp-c2po-no-maypointto.json @@ -0,0 +1,151 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "symb_locks", + "region", + "thread", + "threadJoins", + "c2po", + "startState", + "taintPartialContexts" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "c2po": { + "askbase": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": true, + "id": "enumerate", + "unknown": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "invariant_set" + ], + "invariant-types": [ + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": false, + "other": false, + "accessed": false, + "exact": true, + "exclude-vars": [ + "tmp\\(___[0-9]+\\)?", + "cond", + "RETURN", + "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", + ".*____CPAchecker_TMP_[0-9]+", + "__VERIFIER_assert__cond", + "__ksymtab_.*", + "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" + ] + } + }, + "pre": { + "enabled": false + } + } diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 6428127b0f..5d7ea91015 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1177,7 +1177,8 @@ module MayBeEqual = struct (* If we have a disequality, then they are not equal *) if neq_query (Some cc) (t,v,Z.(z'-z)) then false else (* or if we know that they are not equal according to the query MayPointTo*) - (may_point_to_same_address ask t v Z.(z' - z) cc)) + if GobConfig.get_bool "ana.c2po.askbase" then (may_point_to_same_address ask t v Z.(z' - z) cc) + else true) || (may_be_equal ask cc s t1 v) | Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) | Addr _ , _ | Aux _, _ -> T.is_subterm t1 t2 diff --git a/src/config/options.schema.json b/src/config/options.schema.json index d259a6f418..4de5da3e9b 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -1130,6 +1130,19 @@ }, "additionalProperties": false }, + "c2po": { + "title": "ana.c2po", + "type": "object", + "properties": { + "askbase": { + "title": "ana.c2po.askbase", + "description": "If true, the C-2PO Analysis uses the MayPointTo query to infer additional disequalities.", + "type": "boolean", + "default": true + } + }, + "additionalProperties": false + }, "unassume": { "title": "ana.unassume", "type": "object", diff --git a/tests/regression/83-c2po/03-function-call.c b/tests/regression/83-c2po/03-function-call.c index 7c4f305d27..73dd0f0c3c 100644 --- a/tests/regression/83-c2po/03-function-call.c +++ b/tests/regression/83-c2po/03-function-call.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/07-invertible-assignment2.c b/tests/regression/83-c2po/07-invertible-assignment2.c index ca4b53b2ff..559508e01d 100644 --- a/tests/regression/83-c2po/07-invertible-assignment2.c +++ b/tests/regression/83-c2po/07-invertible-assignment2.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false // example of the paper "2-Pointer Logic" by Seidl et al., Example 9, pag. 22 #include #include diff --git a/tests/regression/83-c2po/09-different-offsets.c b/tests/regression/83-c2po/09-different-offsets.c index 964b6d7f3f..5d420d5851 100644 --- a/tests/regression/83-c2po/09-different-offsets.c +++ b/tests/regression/83-c2po/09-different-offsets.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/10-different-types.c b/tests/regression/83-c2po/10-different-types.c index 78e3df9dc9..0f6e7317aa 100644 --- a/tests/regression/83-c2po/10-different-types.c +++ b/tests/regression/83-c2po/10-different-types.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/13-experiments.c b/tests/regression/83-c2po/13-experiments.c index ef943c80ba..d2023e1e47 100644 --- a/tests/regression/83-c2po/13-experiments.c +++ b/tests/regression/83-c2po/13-experiments.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/14-join.c b/tests/regression/83-c2po/14-join.c index b35d946c49..33fad953f4 100644 --- a/tests/regression/83-c2po/14-join.c +++ b/tests/regression/83-c2po/14-join.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include diff --git a/tests/regression/83-c2po/15-arrays-structs.c b/tests/regression/83-c2po/15-arrays-structs.c index 0e20866ce8..3f68dcf87a 100644 --- a/tests/regression/83-c2po/15-arrays-structs.c +++ b/tests/regression/83-c2po/15-arrays-structs.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/16-loops.c b/tests/regression/83-c2po/16-loops.c index f2a69b187c..792b7fb588 100644 --- a/tests/regression/83-c2po/16-loops.c +++ b/tests/regression/83-c2po/16-loops.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/18-complicated-join.c b/tests/regression/83-c2po/18-complicated-join.c index 0e0515768a..a5f370dedc 100644 --- a/tests/regression/83-c2po/18-complicated-join.c +++ b/tests/regression/83-c2po/18-complicated-join.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false // Example 1 from the paper Join Algorithms for the Theory of Uninterpreted Functions by Gulwani et al. #include diff --git a/tests/regression/83-c2po/19-disequalities.c b/tests/regression/83-c2po/19-disequalities.c index 19f0ada21d..c7c8c8d22a 100644 --- a/tests/regression/83-c2po/19-disequalities.c +++ b/tests/regression/83-c2po/19-disequalities.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/20-self-pointing-struct.c b/tests/regression/83-c2po/20-self-pointing-struct.c index d8dd65230f..3b6af9e865 100644 --- a/tests/regression/83-c2po/20-self-pointing-struct.c +++ b/tests/regression/83-c2po/20-self-pointing-struct.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/22-join-diseq.c b/tests/regression/83-c2po/22-join-diseq.c index 97402da287..c0192e5f93 100644 --- a/tests/regression/83-c2po/22-join-diseq.c +++ b/tests/regression/83-c2po/22-join-diseq.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include diff --git a/tests/regression/83-c2po/23-function-deref.c b/tests/regression/83-c2po/23-function-deref.c index 5e4a0778c6..001dc6887e 100644 --- a/tests/regression/83-c2po/23-function-deref.c +++ b/tests/regression/83-c2po/23-function-deref.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/24-disequalities-small-example.c b/tests/regression/83-c2po/24-disequalities-small-example.c index 652efdf85c..53f2bfcd81 100644 --- a/tests/regression/83-c2po/24-disequalities-small-example.c +++ b/tests/regression/83-c2po/24-disequalities-small-example.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false int *a, b; c() { b = 0; } diff --git a/tests/regression/83-c2po/25-struct-circular.c b/tests/regression/83-c2po/25-struct-circular.c index be237d0fcf..2565c3e9d6 100644 --- a/tests/regression/83-c2po/25-struct-circular.c +++ b/tests/regression/83-c2po/25-struct-circular.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include diff --git a/tests/regression/83-c2po/26-join3.c b/tests/regression/83-c2po/26-join3.c index ae6b5ae743..f2a710a9b0 100644 --- a/tests/regression/83-c2po/26-join3.c +++ b/tests/regression/83-c2po/26-join3.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/27-join-diseq2.c b/tests/regression/83-c2po/27-join-diseq2.c index 7335cf7811..4c02a4b93a 100644 --- a/tests/regression/83-c2po/27-join-diseq2.c +++ b/tests/regression/83-c2po/27-join-diseq2.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false #include #include diff --git a/tests/regression/83-c2po/28-return-value.c b/tests/regression/83-c2po/28-return-value.c index de277e2320..e2016ecae7 100644 --- a/tests/regression/83-c2po/28-return-value.c +++ b/tests/regression/83-c2po/28-return-value.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false int a, b, c; void *d(const *e) { return e + 200; } int *f() {} diff --git a/tests/regression/83-c2po/29-widen.c b/tests/regression/83-c2po/29-widen.c index a79f24619b..606af48d2c 100644 --- a/tests/regression/83-c2po/29-widen.c +++ b/tests/regression/83-c2po/29-widen.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false int a; long b, c, d, e, f, g, h; From ea433bb6d2f382d6196f5467144869de0ecedb1d Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 17:05:50 +0200 Subject: [PATCH 214/323] made a single-threaded analysis lifter --- src/analyses/c2poAnalysis.ml | 3 +- src/analyses/singleThreadedLifter.ml | 61 +++++++++++++++++++ .../weaklyRelationalPointerAnalysis.ml | 3 +- src/goblint_lib.ml | 3 +- 4 files changed, 67 insertions(+), 3 deletions(-) create mode 100644 src/analyses/singleThreadedLifter.ml diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 73dd126ff4..ddaa3663e2 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -6,6 +6,7 @@ open C2poDomain module CC = CongruenceClosure open CC open Batteries +open SingleThreadedLifter module Spec = struct @@ -219,4 +220,4 @@ struct end let _ = - MCP.register_analysis ~dep:["startState"; "taintPartialContexts"] (module Spec : MCPSpec) + MCP.register_analysis ~dep:["startState"; "taintPartialContexts"] (module SingleThreadedLifter(Spec) : MCPSpec) diff --git a/src/analyses/singleThreadedLifter.ml b/src/analyses/singleThreadedLifter.ml new file mode 100644 index 0000000000..39010ab2b2 --- /dev/null +++ b/src/analyses/singleThreadedLifter.ml @@ -0,0 +1,61 @@ +(** A 2-pointer analysis for C. I made this in a few days so please don't judge the code quality. ([2cpo])*) + +open Analyses + +module SingleThreadedLifter (S: MCPSpec) = +struct + include S + + let is_multithreaded (ask:Queries.ask) = ask.f IsEverMultiThreaded + + let query ctx = + if is_multithreaded (ask_of_ctx ctx) then + (fun (type a) (q: a Queries.t): a Queries.result -> Queries.Result.top q) else + query ctx + + let assign ctx lval expr = + if is_multithreaded (ask_of_ctx ctx) then + D.top () else + assign ctx lval expr + + let branch ctx e pos = + if is_multithreaded (ask_of_ctx ctx) then + D.top () else + branch ctx e pos + + let body ctx f = + if is_multithreaded (ask_of_ctx ctx) then + D.top () else + body ctx f + + let return ctx exp_opt f = + if is_multithreaded (ask_of_ctx ctx) then + D.top () else + return ctx exp_opt f + + let special ctx var_opt v exprs = + if is_multithreaded (ask_of_ctx ctx) then + D.top () else + special ctx var_opt v exprs + + let enter ctx var_opt f args = + if is_multithreaded (ask_of_ctx ctx) then + [D.top (),D.top ()] else + enter ctx var_opt f args + + (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t + expr funktionsaufruf*) + let combine_env ctx var_opt expr f exprs t_context_opt t (ask: Queries.ask) = + if is_multithreaded (ask_of_ctx ctx) then + D.top () else + combine_env ctx var_opt expr f exprs t_context_opt t ask + + (*ctx.local is after combine_env, t callee*) + let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = + if is_multithreaded (ask_of_ctx ctx) then + D.top () else + combine_assign ctx var_opt expr f args t_context_opt t ask + + let threadenter ctx ~multiple lval f args = [D.top ()] + let threadspawn ctx ~multiple lval f args fctx = D.top() +end diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml index 3eb8f3d7bd..0f0d933b76 100644 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ b/src/analyses/weaklyRelationalPointerAnalysis.ml @@ -6,6 +6,7 @@ open WeaklyRelationalPointerDomain module CC = CongruenceClosure open CC.CongruenceClosure open Batteries +open SingleThreadedLifter module Spec = struct @@ -219,4 +220,4 @@ struct end let _ = - MCP.register_analysis ~dep:["startState"; "taintPartialContexts"] (module Spec : MCPSpec) + MCP.register_analysis ~dep:["startState"; "taintPartialContexts"] (module SingleThreadedLifter(Spec) : MCPSpec) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 1d23f212bb..e5f2932b6c 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -81,7 +81,6 @@ module LinearTwoVarEqualityAnalysis = LinearTwoVarEqualityAnalysis module VarEq = VarEq module CondVars = CondVars module TmpSpecial = TmpSpecial -module StartStateAnalysis = StartStateAnalysis (** {2 Heap} @@ -172,6 +171,8 @@ module UnassumeAnalysis = UnassumeAnalysis module ExpRelation = ExpRelation module AbortUnless = AbortUnless module PtranalAnalysis = PtranalAnalysis +module StartStateAnalysis = StartStateAnalysis +module SingleThreadedLifter = SingleThreadedLifter (** {1 Domains} From 4dbe6c00b1f5e4fff3c9fb1098b2384a1c4c9e23 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 17:44:12 +0200 Subject: [PATCH 215/323] fix equality function of c2po --- src/cdomains/c2poDomain.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 5d7ea91015..d72e95d4cb 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1079,7 +1079,8 @@ module CongruenceClosure = struct let compare_with_cc2_eq_class (rep1, zmap1) = let rep2, offset = TUF.find_no_pc cc2.uf rep1 in let zmap2 = TMap.find rep2 comp2 in - List.for_all (compare_zmap_entry offset zmap2) (ZMap.bindings zmap1) + if ZMap.cardinal zmap2 <> ZMap.cardinal zmap1 then false else + List.for_all (compare_zmap_entry offset zmap2) (ZMap.bindings zmap1) in List.for_all compare_with_cc2_eq_class (TMap.bindings comp1) @@ -1177,8 +1178,8 @@ module MayBeEqual = struct (* If we have a disequality, then they are not equal *) if neq_query (Some cc) (t,v,Z.(z'-z)) then false else (* or if we know that they are not equal according to the query MayPointTo*) - if GobConfig.get_bool "ana.c2po.askbase" then (may_point_to_same_address ask t v Z.(z' - z) cc) - else true) + if GobConfig.get_bool "ana.c2po.askbase" then (may_point_to_same_address ask t v Z.(z' - z) cc) + else true) || (may_be_equal ask cc s t1 v) | Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) | Addr _ , _ | Aux _, _ -> T.is_subterm t1 t2 @@ -1230,7 +1231,7 @@ module D = struct match x,y with | None, None -> true | Some cc1, Some cc2 -> - equal_eq_classes cc1 cc2 + equal_eq_classes cc1 cc2 && equal_diseqs cc1 cc2 && equal_bldis cc1 cc2 | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res From 1d476df80fc80029e0e1b5797df49e0ef1c6aca8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 18:40:46 +0200 Subject: [PATCH 216/323] (really) fixed equality --- src/cdomains/c2poDomain.ml | 41 ++++++++++++++++++++++++++++---------- 1 file changed, 30 insertions(+), 11 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index d72e95d4cb..38516ad94a 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -388,6 +388,9 @@ module CongruenceClosure = struct | None -> map | Some tset -> TMap.remove v' (TMap.add v tset map) + + let term_set bldis = + TSet.of_enum (TMap.keys bldis) end (** Set of subterms which are present in the current data structure. @@ -1065,8 +1068,6 @@ module CongruenceClosure = struct (** Compares the equivalence classes of cc1 and those of cc2. *) let equal_eq_classes cc1 cc2 = - (* add all terms to both elements *) - let cc1, cc2 = Option.get (insert_set (Some cc1) cc2.set), Option.get (insert_set (Some cc2) cc1.set) in let comp1, comp2 = Disequalities.comp_map cc1.uf, Disequalities.comp_map cc2.uf in (* they should have the same number of equivalence classes *) if TMap.cardinal comp1 <> TMap.cardinal comp2 then false else @@ -1085,27 +1086,39 @@ module CongruenceClosure = struct List.for_all compare_with_cc2_eq_class (TMap.bindings comp1) let equal_diseqs cc1 cc2 = + let normalize_diseqs (min_state1, min_state2, new_offset) = + if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) + else Nequal (min_state2, min_state1, Z.(-new_offset)) in let rename_diseqs dis = match dis with | Nequal (t1,t2,z) -> let (min_state1, min_z1) = TUF.find_no_pc cc2.uf t1 in let (min_state2, min_z2) = TUF.find_no_pc cc2.uf t2 in let new_offset = Z.(-min_z2 + min_z1 + z) in - if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) - else Nequal (min_state2, min_state1, Z.(-new_offset)) + normalize_diseqs (min_state1, min_state2, new_offset) | _ -> dis in - let renamed_diseqs = List.map rename_diseqs (Disequalities.get_disequalities cc1.diseq) in - Set.equal (Set.of_list renamed_diseqs) (Set.of_list (Disequalities.get_disequalities cc2.diseq)) + let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map rename_diseqs (Disequalities.get_disequalities cc1.diseq) in + let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.filter_map (function | Nequal (t1,t2,z) -> Some (normalize_diseqs(t1,t2,z)) + | _ -> None) (Disequalities.get_disequalities cc2.diseq) in + List.equal T.equal_v_prop renamed_diseqs normalized_diseqs let equal_bldis cc1 cc2 = + let normalize_bldis (min_state1, min_state2) = + if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) + else BlNequal (min_state2, min_state1) in let rename_bldis dis = match dis with | BlNequal (t1,t2) -> let min_state1, _ = TUF.find_no_pc cc2.uf t1 in let min_state2, _ = TUF.find_no_pc cc2.uf t2 in - if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) - else BlNequal (min_state2, min_state1) + normalize_bldis (min_state1, min_state2) | _ -> dis in - let renamed_diseqs = List.map rename_bldis (BlDis.to_conj cc1.bldis) in - Set.equal (Set.of_list renamed_diseqs) (Set.of_list (BlDis.to_conj cc2.bldis)) + let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map rename_bldis (BlDis.to_conj cc1.bldis) in + let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map (function | Nequal (t1,t2,_) | Equal(t1,t2,_) | BlNequal (t1,t2) + -> (normalize_bldis(t1,t2))) (BlDis.to_conj cc2.bldis) in + List.equal T.equal_v_prop renamed_diseqs normalized_diseqs end include CongruenceClosure @@ -1231,7 +1244,13 @@ module D = struct match x,y with | None, None -> true | Some cc1, Some cc2 -> - equal_eq_classes cc1 cc2 && equal_diseqs cc1 cc2 && equal_bldis cc1 cc2 + (* add all terms to both elements *) + let terms = SSet.union (SSet.union cc1.set (BlDis.term_set cc1.bldis)) + (SSet.union cc2.set (BlDis.term_set cc2.bldis)) in + let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in + equal_eq_classes cc1 cc2 + && equal_diseqs cc1 cc2 + && equal_bldis cc1 cc2 | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res From 83bf565a7c76eb4c6e5b9e3bd87a91f7127f0cc3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 18:45:03 +0200 Subject: [PATCH 217/323] put back old version of restriction, where we add successors, because the prof described something similar in the paper --- src/cdomains/c2poDomain.ml | 44 ++++++++++++++++++++++++++++++++------ 1 file changed, 37 insertions(+), 7 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 38516ad94a..7d5aee9f23 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -842,6 +842,31 @@ module CongruenceClosure = struct | [] -> TMap.remove parent map | new_children -> TMap.add parent new_children map + (* Returns true if any (strict) subterm of t1 is already present in + the same equivalence class as t2. *) + let rec detect_cyclic_dependencies t1 t2 cc = + match t1 with + | Addr _ | Aux _ -> false + | Deref (t1, _, _) -> + let v1, o1 = TUF.find_no_pc cc.uf t1 in + let v2, o2 = TUF.find_no_pc cc.uf t2 in + if T.equal v1 v2 then true else + detect_cyclic_dependencies t1 t2 cc + + let add_successor_terms cc t = + let add_one_successor (cc, successors) (edge_z, _) = + let _, uf_offset, uf = TUF.find cc.uf t in + let cc = {cc with uf = uf} in + match SSet.deref_term t Z.(edge_z - uf_offset) cc.set with + | exception (T.UnsupportedCilExpression _) -> + (cc, successors) + | successor -> + let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in + let _, cc = if subterm_already_present then (t, Z.zero), cc + else (if M.tracing then M.trace "wrpointer" "insert successor: %s. Map: %s\n" (T.show successor) (LMap.show_map cc.map); Tuple2.map2 Option.get (insert (Some cc) successor)) in + (cc, if subterm_already_present then successors else successor::successors) in + List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) + (** Variables: - `cc`: congruence closure data structure - `predicate`: predicate that returns true for terms which need to be removed from the data structure. @@ -853,14 +878,18 @@ module CongruenceClosure = struct - `cc`: updated congruence closure data structure. *) let remove_terms_from_set cc predicate = - let remove_term (new_set, removed_terms, map_of_children, cc) el = - let new_set, removed_terms = - if predicate cc el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in - let uf_parent = TUF.parent cc.uf el in - let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in - (new_set, removed_terms, map_of_children, cc) + let rec remove_terms_recursive (new_set, removed_terms, map_of_children, cc) = function + | [] -> (new_set, removed_terms, map_of_children, cc) + | el::rest -> + let new_set, removed_terms = if predicate cc el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in + let uf_parent = TUF.parent cc.uf el in + let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in + (* in order to not lose information by removing some elements, we add dereferences values to the union find. + This is what is referred as with "substitution" in the paper. *) + let cc, successors = add_successor_terms cc el in + remove_terms_recursive (new_set, removed_terms, map_of_children, cc) (rest @ successors) in - List.fold remove_term (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) + remove_terms_recursive (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) let show_map_of_children map_of_children = List.fold_left @@ -934,6 +963,7 @@ module CongruenceClosure = struct (fun s (v1, (v2, o2)) -> s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") "" (TMap.bindings new_parents_map) + (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) let rec find_new_root new_parents_map uf v = From d2600d76c7d6ed7db50e3f41a4276afce813bc39 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sat, 6 Jul 2024 18:48:52 +0200 Subject: [PATCH 218/323] is_root now works also with elements that are not in the uf --- src/cdomains/unionFind.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 00158da205..efd63a4a5e 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -543,7 +543,10 @@ module UnionFind = struct (** Returns true if v is the representative value of its equivalence class. Throws "Unknown value" if v is not present in the data structure. *) - let is_root uf v = let (parent_t, _) = parent uf v in T.equal v parent_t + let is_root uf v = + match parent_opt uf v with + | None -> true + | Some (parent_t, _) -> T.equal v parent_t (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements grouped by equivalence classes, while this function just prints them in any order. @@ -608,7 +611,7 @@ module UnionFind = struct else raise (InvalidUnionFind "non-zero self-distance!") else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) - (** Returns find of v if v is in the union find data structure. + (** Returns find of v if v is in the union find data structure. Otherwise it just returns v. *) let find_no_pc_if_possible uf v = match find_no_pc uf v with From e64d5020437740795e12808dd8be4e10ca9e137d Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 10:58:26 +0200 Subject: [PATCH 219/323] implemented widen and narrow --- src/cdomains/c2poDomain.ml | 58 ++++++++++++++++++++++++++++++-------- 1 file changed, 47 insertions(+), 11 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 7d5aee9f23..2b73b08fd1 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1044,15 +1044,8 @@ module CongruenceClosure = struct List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) - (** Here we do the join without using the automata, because apparently - we don't want to describe the automaton in the paper... - - We construct a new cc that contains the elements of cc1.set U cc2.set - and two elements are in the same equivalence class iff they are in the same eq. class - both in cc1 and in cc2. *) - let join_eq cc1 cc2 = - let terms = SSet.union cc1.set cc2.set in - let cc1, cc2 = Option.get (insert_set (Some cc1) cc2.set), Option.get (insert_set (Some cc2) cc1.set) in + let product_no_automata_over_terms cc1 cc2 terms = + let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in let mappings = List.map (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in let r2, off2 = TUF.find_no_pc cc2.uf a in @@ -1064,6 +1057,20 @@ module CongruenceClosure = struct add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in List.fold_left add_term (Some (init_cc []), Map.empty) mappings + (** Here we do the join without using the automata, because apparently + we don't want to describe the automaton in the paper... + + We construct a new cc that contains the elements of cc1.set U cc2.set + and two elements are in the same equivalence class iff they are in the same eq. class + both in cc1 and in cc2. *) + let join_eq cc1 cc2 = + let terms = SSet.union cc1.set cc2.set in + product_no_automata_over_terms cc1 cc2 terms + + (** Same as join, but we only take the terms from the left argument. *) + let widen_eq cc1 cc2 = + product_no_automata_over_terms cc1 cc2 cc1.set + (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. This is done by checking for each disequality if it is implied by both cc. *) @@ -1314,7 +1321,25 @@ module D = struct (show_all res); res - let widen a b = if M.tracing then M.trace "c2po-join" "WIDEN\n";join a b + let widen a b = + if a == b then + a + else + let res = + match a,b with + | None, b -> b + | a, None -> a + | Some a, Some b -> + if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(widen_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) + in + if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" + (show_all res); + res let meet a b = if a == b then @@ -1329,7 +1354,18 @@ module D = struct let leq x y = equal (meet x y) x - let narrow = meet + let narrow a b = + if a == b then + a + else + match a,b with + | None, _ -> None + | _, None -> None + | Some a, Some b -> + let b_conj = List.filter + (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) + (get_normal_form b) in + meet_conjs_opt b_conj (Some a) let pretty_diff () (x,y) = Pretty.dprintf "" From 530f9ef24ce7cfa8f511994d3ce2d7b11967d433 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 11:38:23 +0200 Subject: [PATCH 220/323] some shortcuts, maybe they help --- src/cdomains/c2poDomain.ml | 45 ++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 19 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 2b73b08fd1..2a09105b23 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1281,13 +1281,16 @@ module D = struct match x,y with | None, None -> true | Some cc1, Some cc2 -> - (* add all terms to both elements *) - let terms = SSet.union (SSet.union cc1.set (BlDis.term_set cc1.bldis)) - (SSet.union cc2.set (BlDis.term_set cc2.bldis)) in - let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in - equal_eq_classes cc1 cc2 - && equal_diseqs cc1 cc2 - && equal_bldis cc1 cc2 + if cc1 == cc2 then + true + else + (* add all terms to both elements *) + let terms = SSet.union (SSet.union cc1.set (BlDis.term_set cc1.bldis)) + (SSet.union cc2.set (BlDis.term_set cc2.bldis)) in + let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in + equal_eq_classes cc1 cc2 + && equal_diseqs cc1 cc2 + && equal_bldis cc1 cc2 | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res @@ -1301,21 +1304,24 @@ module D = struct let is_top = function None -> false | Some cc -> TUF.is_empty cc.uf - let join a b = - if a == b then - a + let join a' b' = + if a' == b' then + a' else let res = - match a,b with + match a',b' with | None, b -> b | a, None -> a | Some a, Some b -> - if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) + if a == b then + a' + else + (if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(join_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); @@ -1349,8 +1355,9 @@ module D = struct | None, _ -> None | _, None -> None | Some a, b -> - let a_conj = get_normal_form a in - meet_conjs_opt a_conj b + match get_normal_form a with + | [] -> b + | a_conj -> meet_conjs_opt a_conj b let leq x y = equal (meet x y) x From 807eefe97e33d8291db9e547a1577161a022d2ab Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 14:56:08 +0200 Subject: [PATCH 221/323] reswitched to the new version of restricting. Because the prof wrote in the paper that we can just substitute subexpressions, and this corresponds basically to the version of restricting, that wrpointer used. Also, the version that was currently implemented was buggy, because the lookup map has only one successor, before it had more than one. --- src/cdomains/c2poDomain.ml | 318 ++++++++++++++----------------------- 1 file changed, 116 insertions(+), 202 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 2a09105b23..0b61706a79 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -830,214 +830,127 @@ module CongruenceClosure = struct Some {cc with bldis} (* Remove variables: *) - - let add_to_map_of_children value map term = - if T.equal term value then map else - match TMap.find_opt term map with - | None -> TMap.add term [value] map - | Some list -> TMap.add term (value::list) map - - let remove_from_map_of_children parent child map = - match List.remove_if (T.equal child) (TMap.find parent map) with - | [] -> TMap.remove parent map - | new_children -> TMap.add parent new_children map - - (* Returns true if any (strict) subterm of t1 is already present in - the same equivalence class as t2. *) - let rec detect_cyclic_dependencies t1 t2 cc = - match t1 with - | Addr _ | Aux _ -> false - | Deref (t1, _, _) -> - let v1, o1 = TUF.find_no_pc cc.uf t1 in - let v2, o2 = TUF.find_no_pc cc.uf t2 in - if T.equal v1 v2 then true else - detect_cyclic_dependencies t1 t2 cc - - let add_successor_terms cc t = - let add_one_successor (cc, successors) (edge_z, _) = - let _, uf_offset, uf = TUF.find cc.uf t in - let cc = {cc with uf = uf} in - match SSet.deref_term t Z.(edge_z - uf_offset) cc.set with - | exception (T.UnsupportedCilExpression _) -> - (cc, successors) - | successor -> - let subterm_already_present = SSet.mem successor cc.set || detect_cyclic_dependencies t t cc in - let _, cc = if subterm_already_present then (t, Z.zero), cc - else (if M.tracing then M.trace "wrpointer" "insert successor: %s. Map: %s\n" (T.show successor) (LMap.show_map cc.map); Tuple2.map2 Option.get (insert (Some cc) successor)) in - (cc, if subterm_already_present then successors else successor::successors) in - List.fold_left add_one_successor (cc, []) (LMap.successors (Tuple3.first (TUF.find cc.uf t)) cc.map) - - (** Variables: - - `cc`: congruence closure data structure - - `predicate`: predicate that returns true for terms which need to be removed from the data structure. - It takes `uf` as a parameter. - Returns: - - `new_set`: subset of `set` which contains the terms that do not have to be removed. - - `removed_terms`: list of all elements of `set` which contains the terms that have to be removed. - - `map_of_children`: maps each element of union find to its children in the union find tree. It is used in order to later remove these elements from the union find data structure. - - `cc`: updated congruence closure data structure. - *) - let remove_terms_from_set cc predicate = - let rec remove_terms_recursive (new_set, removed_terms, map_of_children, cc) = function - | [] -> (new_set, removed_terms, map_of_children, cc) - | el::rest -> - let new_set, removed_terms = if predicate cc el then new_set, el::removed_terms else SSet.add el new_set, removed_terms in - let uf_parent = TUF.parent cc.uf el in - let map_of_children = add_to_map_of_children el map_of_children (fst uf_parent) in - (* in order to not lose information by removing some elements, we add dereferences values to the union find. - This is what is referred as with "substitution" in the paper. *) - let cc, successors = add_successor_terms cc el in - remove_terms_recursive (new_set, removed_terms, map_of_children, cc) (rest @ successors) + let remove_terms_from_eq predicate cc = + let rec insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in + (* start from all initial states that are still valid and find new representatives if necessary *) + (* new_reps maps each representative term to the new representative of the equivalence class *) + (*but new_reps contains an element but not necessarily the representative!!*) + let find_new_repr state old_rep old_z new_reps = + match LMap.find_opt old_rep new_reps with + | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps + | None -> if not @@ predicate old_rep then + old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) + (* the representative need to be removed from the data structure: state is the new repr.*) + state, Z.zero, TMap.add old_rep (state, old_z) new_reps in + let add_atom (new_reps, new_cc, reachable_old_reps) state = + let old_rep, old_z = TUF.find_no_pc cc.uf state in + let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in + let new_cc = insert_terms new_cc [state; new_rep] in + let new_cc = closure new_cc [(state, new_rep, new_z)] in + (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) in - remove_terms_recursive (SSet.empty, [], TMap.empty, cc) (SSet.to_list cc.set) - - let show_map_of_children map_of_children = - List.fold_left - (fun s (v, list) -> - s ^ T.show v ^ "\t:\n" ^ - List.fold_left - (fun s v -> - s ^ T.show v ^ "; ") - "\t" list ^ "\n") - "" (TMap.bindings map_of_children) - - (** Removes all terms in "removed_terms" from the union find data structure. - Returns: - - `uf`: the updated union find tree - - `new_parents_map`: maps each removed term t to another term which was in the same equivalence class as t at the time when t was deleted. - *) - let remove_terms_from_uf cc removed_terms map_of_children predicate = - let find_not_removed_element set = match List.find (fun el -> not (predicate cc el)) set with - | exception Not_found -> List.first set - | t -> t - in - let remove_term (uf, new_parents_map, map_of_children) t = - match LMap.find_opt t map_of_children with - | None -> - (* t has no children, so we can safely delete the element from the data structure *) - (* we just need to update the size on the whole path from here to the root *) - let new_parents_map = if TUF.is_root uf t then new_parents_map else LMap.add t (TUF.parent uf t) new_parents_map in - let parent = fst (TUF.parent uf t) in - let map_of_children = if TUF.is_root uf t then map_of_children else remove_from_map_of_children parent t map_of_children in - (TUF.ValMap.remove t (TUF.modify_size t uf pred), new_parents_map, map_of_children) - | Some children -> - let map_of_children = LMap.remove t map_of_children in - if TUF.is_root uf t then - (* t is a root and it has some children: - 1. choose new root. - The new_root is in any case one of the children of the old root. - If possible, we choose one of the children that is not going to be deleted. *) - let new_root = find_not_removed_element children in - let remaining_children = List.remove_if (T.equal new_root) children in - let offset_new_root = TUF.parent_offset uf new_root in - (* We set the parent of all the other children to the new root and adjust the offset accodingly. *) - let new_size, map_of_children, uf = List.fold - (fun (total_size, map_of_children, uf) child -> - (* update parent and offset *) - let uf = TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf child - offset_new_root)) in - total_size + TUF.subtree_size uf child, add_to_map_of_children child map_of_children new_root, uf - ) (0, map_of_children, uf) remaining_children in - (* Update new root -> set itself as new parent. *) - let uf = TUF.modify_parent uf new_root (new_root, Z.zero) in - (* update size of equivalence class *) - let uf = TUF.modify_size new_root uf ((+) new_size) in - (TUF.ValMap.remove t uf, LMap.add t (new_root, Z.(-offset_new_root)) new_parents_map, map_of_children) + let new_reps, new_cc, reachable_old_reps = + SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some(init_cc [])),[]) cc.set in + let cmap = Disequalities.comp_map cc.uf in + (* breadth-first search of reachable states *) + let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = + let old_rep_s, old_z_s = TUF.find_no_pc cc.uf s_t in + let find_successor_in_set (z, term_set) = + let exception Found in + let res = ref None in + try + TSet.iter (fun t -> + match SSet.deref_term t Z.(s_z-z) cc.set with + | exception (T.UnsupportedCilExpression _) -> () + | successor -> if (not @@ predicate successor) then + (res := Some successor; raise Found) + else + () + ) term_set; !res + with Found -> !res + in + (* find successor term -> find any element in equivalence class that can be dereferenced *) + match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with + | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then + let new_cc = insert_terms new_cc [successor_term] in + match LMap.find_opt old_rep_s new_reps with + | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) + new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps + | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. + -> we choose a successor term *(t+z) for any + -> we need add the successor state to the list of states that still need to be visited + *) + TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps else - (* t is NOT a root -> the old parent of t becomes the new parent of the children of t. *) - let (new_root, new_offset) = TUF.parent uf t in - let remaining_children = List.remove_if (T.equal new_root) children in - (* update all parents of the children of t *) - let map_of_children, uf = List.fold - (fun (map_of_children, uf) child -> - (* update parent and offset *) - add_to_map_of_children child map_of_children new_root, - TUF.modify_parent uf child (new_root, Z.(TUF.parent_offset uf t + new_offset)) - ) (map_of_children, uf) remaining_children in - (* update size of equivalence class *) - let uf = TUF.modify_size new_root uf pred in - (TUF.ValMap.remove t uf, LMap.add t (new_root, new_offset) new_parents_map, map_of_children) + (new_reps, new_cc, reachable_old_reps) + | None -> + (* the term cannot be dereferenced, so we won't add this transition. *) + (new_reps, new_cc, reachable_old_reps) in - List.fold_left remove_term (cc.uf, LMap.empty, map_of_children) removed_terms - - let show_new_parents_map new_parents_map = List.fold_left - (fun s (v1, (v2, o2)) -> - s ^ T.show v1 ^ "\t: " ^ T.show v2 ^ ", " ^ Z.to_string o2 ^"\n") - "" (TMap.bindings new_parents_map) + (* find all successors that are still reachable *) + let rec add_transitions new_reps new_cc = function + | [] -> new_reps, new_cc + | (old_rep, new_rep, z)::rest -> + let successors = LMap.successors old_rep cc.map in + let new_reps, new_cc, reachable_old_reps = + List.fold (add_transition (old_rep, new_rep,z)) (new_reps, new_cc, []) successors in + add_transitions new_reps new_cc (rest@reachable_old_reps) + in add_transitions new_reps new_cc + (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) - let rec find_new_root new_parents_map uf v = - match LMap.find_opt v new_parents_map with - | None -> TUF.find_opt uf v - | Some (new_parent, new_offset) -> - match find_new_root new_parents_map uf new_parent with - | None -> None - | Some (r, o, uf) -> Some (r, Z.(o + new_offset), uf) - - (** Removes all terms from the mapped values of this map, - for which "predicate" is false. *) - let remove_terms_from_mapped_values map predicate = - LMap.filter_if map (not % predicate) - - (** For all the elements in the removed terms set, it moves the mapped value to the new root. - Returns new map and new union-find. *) - let remove_terms_from_map (uf, map) removed_terms new_parents_map = - let remove_from_map (map, uf) term = - match LMap.find_opt term map with - | None -> map, uf - | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) - match find_new_root new_parents_map uf term with - | None -> LMap.remove term map, uf - | Some (new_root, new_offset, uf) -> LMap.shift new_root new_offset term map, uf - in List.fold_left remove_from_map (map, uf) removed_terms - - let remove_terms_from_diseq (diseq: Disequalities.t) removed_terms predicate new_parents_map uf = - (* modify mapped values - -> change terms to their new representatives or remove them, if the representative class was completely removed. *) - let diseq = Disequalities.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (Disequalities.filter_if diseq (not % predicate)) in - (* modify left hand side of map *) - let res, uf = remove_terms_from_map (uf, diseq) removed_terms new_parents_map in - if M.tracing then M.trace "c2po-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (Disequalities.show_neq res) (TUF.show_uf uf); res, uf - - let remove_terms_from_bldis (diseq: BlDis.t) removed_terms predicate new_parents_map uf = - (* modify mapped values - -> change terms to their new representatives or remove them, if the representative class was completely removed. *) - let diseq = BlDis.filter_map (Option.map Tuple3.first % find_new_root new_parents_map uf) (BlDis.filter_if diseq (not % predicate)) in - (* modify left hand side of map *) - let remove_terms_from_bldis (uf, map) removed_terms new_parents_map = - let remove_from_map (map, uf) term = - match LMap.find_opt term map with - | None -> map, uf - | Some _ -> (* move this entry in the map to the new representative of the equivalence class where term was before. If it still exists. *) - match find_new_root new_parents_map uf term with - | None -> LMap.remove term map, uf - | Some (new_root, new_offset, uf) -> BlDis.shift new_root new_offset term map, uf - in List.fold_left remove_from_map (map, uf) removed_terms in - let res, uf = remove_terms_from_bldis (uf, diseq) removed_terms new_parents_map in - if M.tracing then M.trace "c2po-neq" "remove_terms_from_diseq: %s\nUnion find: %s\n" (show_conj(BlDis.to_conj res)) (TUF.show_uf uf); res, uf + let find_new_root new_reps uf v = + match TMap.find_opt v new_reps with + | None -> None + | Some (new_t, z1) -> + let t_rep, z2 = TUF.find_no_pc uf new_t in + Some (t_rep, Z.(z2-z1)) + + let remove_terms_from_diseq diseq new_reps cc = + let disequalities = Disequalities.get_disequalities diseq + in + let add_disequality new_diseq = function + | Nequal(t1,t2,z) -> + begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with + | Some (t1',z1'), Some (t2', z2') -> (t1', t2', Z.(z2'+z-z1'))::new_diseq + | _ -> new_diseq + end + | _-> new_diseq + in + let new_diseq = List.fold add_disequality [] disequalities + in congruence_neq cc new_diseq + + let remove_terms_from_bldis bldis new_reps cc = + let disequalities = BlDis.to_conj bldis + in + let add_bl_dis new_diseq = function + | BlNequal (t1,t2) -> + begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with + | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq (t1', t2') + | _ -> new_diseq + end + | _-> new_diseq + in + List.fold add_bl_dis BlDis.empty disequalities (** Remove terms from the data structure. It removes all terms for which "predicate" is false, while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = let old_cc = cc in - (* first find all terms that need to be removed *) - let set, removed_terms, map_of_children, cc = - remove_terms_from_set cc predicate - in if M.tracing then M.trace "c2po" "REMOVE TERMS: %s\n BEFORE: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all old_cc); - let uf, new_parents_map, _ = - remove_terms_from_uf cc removed_terms map_of_children predicate - in let map = - remove_terms_from_mapped_values cc.map (predicate cc) - in let map, uf = - remove_terms_from_map (uf, map) removed_terms new_parents_map - in let diseq, uf = - remove_terms_from_diseq cc.diseq removed_terms (predicate cc) new_parents_map uf - in let bldis, uf = remove_terms_from_bldis cc.bldis removed_terms (predicate cc) new_parents_map uf - in if M.tracing then M.trace "c2po" "REMOVE TERMS: %s\n BEFORE: %s\nRESULT: %s\n" (List.fold_left (fun s t -> s ^ "; " ^ T.show t) "" removed_terms) - (show_all old_cc) (show_all {uf; set; map; diseq; bldis}); - {uf; set; map; diseq; bldis} + match remove_terms_from_eq predicate cc with + | new_reps, Some cc -> + begin match remove_terms_from_diseq old_cc.diseq new_reps cc with + | Some cc -> + let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in + if M.tracing then M.trace "c2po" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" + (show_all old_cc) (show_all {uf=cc.uf; set = cc.set; map = cc.map; diseq=cc.diseq; bldis}); + Some {uf=cc.uf; set = cc.set; map = cc.map; diseq=cc.diseq; bldis} + | None -> None + end + | _,None -> None + (* join *) let show_pmap pmap= @@ -1292,7 +1205,7 @@ module D = struct && equal_diseqs cc1 cc2 && equal_bldis cc1 cc2 | _ -> false - in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} @@ -1391,14 +1304,14 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = if M.tracing then M.trace "c2po" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - Option.map (remove_terms (fun cc t -> Var.equal (T.get_var t) var)) cc + Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = if M.tracing then M.trace "c2po" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.map (remove_terms (fun cc -> T.contains_variable vars)) cc + Option.bind cc (remove_terms (T.contains_variable vars)) (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", @@ -1406,18 +1319,19 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.map (remove_terms (fun cc t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) cc + Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "c2po" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in - Option.map (remove_terms (fun cc t -> MayBeEqual.may_be_equal ask (Some cc) s term t)) cc + Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.map (remove_terms (fun cc t -> MayBeEqual.may_point_to_one_of_these_adresses ask address cc t)) cc + Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) + end From 286d1bef71b980107eac4356e31cf615e7997632 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 16:45:08 +0200 Subject: [PATCH 222/323] removed all code duplication, but I also removed min_repr, so I will have to add it again later --- src/analyses/c2poAnalysis.ml | 2 +- src/cdomains/c2poDomain.ml | 1085 +---------------------------- src/cdomains/congruenceClosure.ml | 370 ++++++---- 3 files changed, 261 insertions(+), 1196 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index ddaa3663e2..b1b95afd6d 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -76,7 +76,7 @@ struct ID.of_bool ik res end (* TODO Invariant. - | Queries.Invariant context -> get_normal_form context*) + | Queries.Invariant context -> get_conjunction context*) (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) | _ -> Result.top q diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 0b61706a79..02fb425a4f 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1,1077 +1,10 @@ (** It's the same as wrpointer but less precise and hopefully more efficient? *) -include UnionFind + +open CongruenceClosure +include CongruenceClosure open Batteries open GoblintCil module Var = CilType.Varinfo -module M = Messages - -(** Quantitative congruence closure on terms *) -module CongruenceClosure = struct - - module TUF = UnionFind - module LMap = LookupMap - - module Disequalities = struct - - (* disequality map: - if t_1 -> z -> {t_2, t_3} - then we know that t_1 + z != t_2 - and also that t_1 + z != t_3 - *) - type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) - type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) - - let empty = TMap.empty - let remove = TMap.remove - (** Returns a list of tuples, which each represent a disequality *) - let bindings = - List.flatten % - List.concat_map - (fun (t, smap) -> - List.map (fun (z, tset) -> - List.map (fun term -> - (t,z,term)) (TSet.elements tset)) - (ZMap.bindings smap) - ) % TMap.bindings - - let bindings_args = - List.flatten % - List.concat_map - (fun (t, smap) -> - List.map (fun (z, arglist) -> - List.map (fun (a,b) -> - (t,z,a,b)) arglist) - (ZMap.bindings smap) - ) % TMap.bindings - - (** adds a mapping v -> r -> size -> { v' } to the map, - or if there are already elements - in v -> r -> {..} then v' is added to the previous set *) - let map_set_add (v,r) v' (map:t) = match TMap.find_opt v map with - | None -> TMap.add v (ZMap.add r (TSet.singleton v') ZMap.empty) map - | Some imap -> TMap.add v ( - match ZMap.find_opt r imap with - | None -> ZMap.add r (TSet.singleton v') imap - | Some set -> ZMap.add r (TSet.add v' set) imap) map - - let shift = LMap.shift - - let map_set_mem (v,r) v' (map:t) = match TMap.find_opt v map with - | None -> false - | Some imap -> (match ZMap.find_opt r imap with - | None -> false - | Some set -> TSet.mem v' set - ) - - (** Map of partition, transform union find to a map - of type V -> Z -> V set - with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) - let comp_map uf = List.fold_left (fun comp (v,_) -> - map_set_add (TUF.find_no_pc uf v) v comp) - TMap.empty (TMap.bindings uf) - - (** Find all elements that are in the same equivalence class as t. *) - let comp_t uf t = - let (t',z') = TUF.find_no_pc uf t in - List.fold_left (fun comp (v,((p,z),_)) -> - let (v', z'') = TUF.find_no_pc uf v in - if T.equal v' t' then (v, Z.(z'-z''))::comp else comp - ) - [] (TMap.bindings uf) - - let flatten_map = - ZMap.map (fun zmap -> List.fold_left - (fun set (_,mapped) -> TSet.union set mapped) TSet.empty (ZMap.bindings zmap)) - - (** arg: - - maps each representative term t to a map that maps an integer Z to - a list of representatives t' of v where *(v + z') is - in the representative class of t. - - It basically maps each state in the automata to its predecessors. *) - let get_args uf = - let cmap = comp_map uf in - let clist = TMap.bindings cmap in - let arg = List.fold_left (fun arg (v, imap) -> - let ilist = ZMap.bindings imap in - let iarg = List.fold_left (fun iarg (r,set) -> - let list = List.filter_map (function - | Deref (v', r', _) -> - let (v0,r0) = TUF.find_no_pc uf v' in - Some (v0,Z.(r0+r')) - | _ -> None) (TSet.elements set) in - ZMap.add r list iarg) ZMap.empty ilist in - TMap.add v iarg arg) TMap.empty clist in - (uf,cmap,arg) - - let fold_left2 f acc l1 l2 = - List.fold_left ( - fun acc x -> List.fold_left ( - fun acc y -> f acc x y) acc l2) acc l1 - - let map2 f l1 l2 = List.concat_map (fun x -> - List.map (fun y -> f x y) l2) l1 - - let map_find_opt (v,r) map = match TMap.find_opt v map with - | None -> None - | Some imap -> (match ZMap.find_opt r imap with - | None -> None - | Some v -> Some v - ) - - let map_find_all t map = - match TMap.find_opt t map with - | None -> [] - | Some imap -> List.fold (fun list (z,list2) -> - list@list2 - ) [] (ZMap.bindings imap) - - (** Find all disequalities of the form t1 != z2-z1 + t2 - that can be inferred from equalities of the form *(z1 + t1) = *(z2 + t2). - *) - let check_neq (_,arg) rest (v,zmap) = - let zlist = ZMap.bindings zmap in - fold_left2 (fun rest (r1,_) (r2,_) -> - if Z.equal r1 r2 then rest - else (* r1 <> r2 *) - let l1 = match map_find_opt (v,r1) arg - with None -> [] - | Some list -> list in - (* just take the elements of set1 ? *) - let l2 = match map_find_opt (v,r2) arg - with None -> [] - | Some list -> list in - fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if T.equal v1 v2 then if Z.equal r'1 r'2 - then raise Unsat - else rest - else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 - ) rest zlist zlist - - (** Find all disequalities of the form t1 != z2-z1 + t2 - that can be inferred from block equalities of the form bl( *(z1 + t1) ) = bl( *(z2 + t2) ). - *) - let check_neq_bl (uf,arg) rest (t1, tset) = - List.fold (fun rest t2 -> - (* if T.equal (fst@@TUF.find_no_pc_if_possible uf t1) (fst@@TUF.find_no_pc_if_possible uf t2) - then raise Unsat - else*) (* r1 <> r2 *) - let l1 = map_find_all t1 arg in - let l2 = map_find_all t2 arg in - fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if T.equal v1 v2 then if Z.equal r'1 r'2 - then raise Unsat - else rest - else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 - ) rest (TSet.to_list tset) - - (** Initialize the list of disequalities taking only implicit dis-equalities into account. - - Returns: List of non-trivially implied dis-equalities *) - let init_neq (uf,cmap,arg) = - List.fold_left (check_neq (uf,arg)) [] (TMap.bindings cmap) - - let init_neg_block_diseq (uf, bldis, cmap, arg) = - List.fold_left (check_neq_bl (uf,arg)) [] (TMap.bindings bldis) - - (** Initialize the list of disequalities taking explicit dis-equalities into account. - - Parameters: union-find partition, explicit disequalities.battrs - - Returns: list of normalized provided dis-equalities *) - let init_list_neq uf neg = - List.filter_map (fun (v1,v2,r) -> - let (v1,r1) = TUF.find_no_pc uf v1 in - let (v2,r2) = TUF.find_no_pc uf v2 in - if T.equal v1 v2 then if Z.(equal r1 (r2+r)) then raise Unsat - else None - else Some (v1,v2,Z.(r2-r1+r))) neg - - (** Parameter: list of disequalities (t1, t2, z), where t1 and t2 are roots. - - Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. - *) - let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) - | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) - | (v1,v2,r) :: rest -> - (* we don't want to explicitly store disequalities of the kind &x != &y *) - if T.is_addr v1 && T.is_addr v2 then - propagate_neq (uf,cmap,arg,neq) rest else - (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) - if T.equal v1 v2 then (* should not happen *) - if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) rest - else (* check whether it is already in neq *) - if map_set_mem (v1,Z.(-r)) v2 neq then propagate_neq (uf,cmap,arg,neq) rest - else let neq = map_set_add (v1,Z.(-r)) v2 neq |> - map_set_add (v2,r) v1 in - (* - search components of v1, v2 for elements at distance r to obtain inferred equalities - at the same level (not recorded) and then compare their predecessors - *) - match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with - | None,_ | _,None -> (*should not happen*) propagate_neq (uf,cmap,arg,neq) rest - | Some imap1, Some imap2 -> - let ilist1 = ZMap.bindings imap1 in - let rest = List.fold_left (fun rest (r1,_) -> - match ZMap.find_opt Z.(r1+r) imap2 with - | None -> rest - | Some _ -> - let l1 = match map_find_opt (v1,r1) arg - with None -> [] - | Some list -> list in - let l2 = match map_find_opt (v2,Z.(r1+r)) arg - with None -> [] - | Some list -> list in - fold_left2 (fun rest (v1',r'1) (v2',r'2) -> - if T.equal v1' v2' then if Z.equal r'1 r'2 then raise Unsat - else rest - else - (v1',v2',Z.(r'2-r'1))::rest ) rest l1 l2) - rest ilist1 in - propagate_neq (uf,cmap,arg,neq) rest - (* - collection of disequalities: - * disequalities originating from different offsets of same root - * disequalities originating from block disequalities - * stated disequalities - * closure by collecting appropriate args - for a disequality v1 != v2 +r for distinct roots v1,v2 - check whether there is some r1, r2 such that r1 = r2 +r - then dis-equate the sets at v1,r1 with v2,r2. - *) - - let show_neq neq = - let clist = bindings neq in - List.fold_left (fun s (v,r,v') -> - s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " - ^ T.show v' ^ "\n") "" clist - - let show_cmap neq = - let clist = bindings neq in - List.fold_left (fun s (v,r,v') -> - s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " = " - ^ T.show v' ^ "\n") "" clist - - let show_arg arg = - let clist = bindings_args arg in - List.fold_left (fun s (v,z,v',r) -> - s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " --> " - ^ T.show v^ "+"^ Z.to_string z ^ "\n") "" clist - - let filter_if map p = - TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ t_set -> let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) zmap - in if ZMap.is_empty zmap then None else Some zmap) map - - let filter_map f (diseq:t) = - TMap.filter_map - (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ s -> let set = TSet.filter_map f s in - if TSet.is_empty set then None else Some set) - zmap in if ZMap.is_empty zmap then None else Some zmap) diseq - - let get_disequalities = List.map - (fun (t1, z, t2) -> - Nequal (t1,t2,Z.(-z)) - ) % bindings - - (** For each disequality t1 != z + t2 we add all disequalities - that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', - then we add the disequaity t1' != z + z2 - z1 + t2'. - *) - let element_closure diseqs cmap = - let comp_closure (r1,r2,z) = - let to_tuple_list = (*TODO this is not the best solution*) - List.flatten % List.map - (fun (z, set) -> List.cartesian_product [z] (TSet.to_list set)) in - let comp_closure_zmap bindings1 bindings2 = - List.map (fun ((z1, nt1),(z2, nt2)) -> - (nt1, nt2, Z.(-z2+z+z1))) - (List.cartesian_product (to_tuple_list bindings1) (to_tuple_list bindings2)) - in - let singleton term = [Z.zero, TSet.singleton term] in - begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with - | None, None -> [(r1,r2,z)] - | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) - | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) - | Some zmap1, Some zmap2 -> - comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) - end - in - List.concat_map comp_closure diseqs - end - - (* block disequalities *) - module BlDis = struct - (** Block disequalities: - a term t1 is mapped to a set of terms that have a different block than t1. - It is allowed to contain terms that are not present in the data structure, - so we shouldn't assume that all terms in bldis are present in the union find! - *) - type t = TSet.t TMap.t [@@deriving eq, ord, hash] - - let bindings = TMap.bindings - let empty = TMap.empty - - let to_conj bldiseq = List.fold - (fun list (t1, tset) -> - TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list - ) [] (bindings bldiseq) - - let add bldiseq t1 t2 = - match TMap.find_opt t1 bldiseq with - | None -> TMap.add t1 (TSet.singleton t2) bldiseq - | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq - - (** Add disequalities bl(t1) != bl(t2) and bl(t2) != bl(t1). *) - let add_block_diseq bldiseq (t1, t2) = - add (add bldiseq t1 t2) t2 t1 - - (** - params: - - t1-> a term that is NOT present in the data structure - - tlist: a list of representative terms - - For each term t2 in tlist, it adds the disequality t1 != t2 to diseqs. - *) - let add_block_diseqs bldiseq uf t1 tlist = - List.fold (fun bldiseq t2 -> - add_block_diseq bldiseq (t1, t2)) bldiseq tlist - - (** For each block disequality bl(t1) != bl(t2) we add all disequalities - that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', - then we add the disequaity bl(t1') != bl(t2'). - *) - let element_closure bldis cmap = - let comp_closure = function - | BlNequal (r1,r2) -> - let to_list = (*TODO this is not the best solution*) - List.flatten % List.map - (fun (z, set) -> (TSet.to_list set)) in - let comp_closure_zmap bindings1 bindings2 = - List.cartesian_product (to_list bindings1) (to_list bindings2) - in - let singleton term = [(Z.zero, TSet.singleton term)] in - begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with - | None, None -> [(r1,r2)] - | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) - | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) - | Some zmap1, Some zmap2 -> - comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) - end - | _ -> [] - in - List.concat_map comp_closure bldis - - let map_set_mem v v' (map:t) = match TMap.find_opt v map with - | None -> false - | Some set -> TSet.mem v' set - - let filter_if (map:t) p = - TMap.filter_map (fun _ t_set -> - let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) map - - let filter_map f (diseq:t) = - TMap.filter_map - (fun _ s -> let set = TSet.filter_map f s in - if TSet.is_empty set then None else Some set) diseq - - let shift v r v' (map:t) = - match TMap.find_opt v' map with - | None -> map - | Some tset -> - TMap.remove v' (TMap.add v tset map) - - let term_set bldis = - TSet.of_enum (TMap.keys bldis) - end - - (** Set of subterms which are present in the current data structure. - TODO: check if it is needed? Because this information is implicitly present in the union find data structure. *) - module SSet = struct - type t = TSet.t [@@deriving eq, ord, hash] - - let elements = TSet.elements - let mem = TSet.mem - let add = TSet.add - let fold = TSet.fold - let empty = TSet.empty - let to_list = TSet.to_list - let inter = TSet.inter - let find_opt = TSet.find_opt - let union = TSet.union - - let show_set set = TSet.fold (fun v s -> - s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" - - (** Adds all subterms of t to the SSet and the LookupMap*) - let rec subterms_of_term (set,map) t = match t with - | Addr _ | Aux _ -> (add t set, map) - | Deref (t',z,_) -> - let set = add t set in - let map = LMap.map_add (t',z) t map in - subterms_of_term (set, map) t' - - (** Adds all subterms of the proposition to the SSet and the LookupMap*) - let subterms_of_prop (set,map) = function - | (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 - - let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list - - let fold_atoms f (acc:'a) set:'a = - let exception AtomsDone in - let res = ref acc in - try - TSet.fold (fun (v:T.t) acc -> match v with - | Addr _| Aux _ -> f acc v - | _ -> res := acc; raise AtomsDone) set acc - with AtomsDone -> !res - - let get_atoms set = - (* `elements set` returns a sorted list of the elements. The atoms are always smaller that other terms, - according to our comparison function. Therefore take_while is enough. *) - BatList.take_while (function Addr _ | Aux _ -> true | _ -> false) (elements set) - - (** We try to find the dereferenced term between the already existing terms, in order to remember the information about the exp. *) - let deref_term t z set = - let exp = T.to_cil t in - match find_opt (Deref (t, z, exp)) set with - | None -> Deref (t, z, T.dereference_exp exp z) - | Some t -> t - - (** Sometimes it's important to keep the dereferenced term, - even if it's not technically possible to dereference it from a point of view of the C types. - We still need the dereferenced term for he correctness of some algorithms, - and the resulting expression will never be used, so it doesn't need to be a - C expression hat makes sense. *) - let deref_term_even_if_its_not_possible min_term z set = - match deref_term min_term z set with - | result -> result - | exception (T.UnsupportedCilExpression _) -> - let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr and get_normal_form*) - Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z (Some random_type), random_type)), NoOffset)) - - end - - type t = {uf: TUF.t; - set: SSet.t; - map: LMap.t; - diseq: Disequalities.t; - bldis: BlDis.t} - [@@deriving eq, ord, hash] - - let string_of_prop = function - | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 - | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 - | Nequal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 - | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 - | BlNequal (t1,t2) -> "bl(" ^ T.show t1 ^ ") != bl(" ^ T.show t2 ^ ")" - - let show_conj list = List.fold_left - (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list - - (** Returns a list of all the transition that are present in the automata. *) - let get_transitions (uf, map) = - List.concat_map (fun (t, zmap) -> - (List.map (fun (edge_z, res_t) -> - (edge_z, t, TUF.find_no_pc uf res_t)) @@ - (LMap.zmap_bindings zmap))) - (LMap.bindings map) - - (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) - Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) - (** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) - let get_normal_form cc = - let normalize_equality (t1, t2, z) = - if T.equal t1 t2 && Z.(equal z zero) then None else - Some (Equal (t1, t2, z)) in - let conjunctions_of_atoms = - let atoms = SSet.get_atoms cc.set in - List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in - normalize_equality (atom, rep_state, rep_z) - ) atoms - in - let conjunctions_of_transitions = - let transitions = get_transitions (cc.uf, cc.map) in - List.filter_map (fun (z,s,(s',z')) -> - normalize_equality (SSet.deref_term_even_if_its_not_possible s z cc.set, s', z') - ) transitions in - (*disequalities*) - let disequalities = Disequalities.get_disequalities cc.diseq in - (* find disequalities between min_repr *) - let normalize_disequality (t1, t2, z) = - if T.compare t1 t2 < 0 then Nequal (t1, t2, z) - else Nequal (t2, t1, Z.(-z)) - in - if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); - let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in - (* block disequalities *) - let normalize_bldis t = match t with - | BlNequal (t1,t2) -> - if T.compare t1 t2 < 0 then BlNequal (t1, t2) - else BlNequal (t2, t1) - | _ -> t - in - let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in - (* all propositions *) - BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) - - let show_all x = "Normal form:\n" ^ - show_conj((get_normal_form x)) ^ - "Union Find partition:\n" ^ - (TUF.show_uf x.uf) - ^ "\nSubterm set:\n" - ^ (SSet.show_set x.set) - ^ "\nLookup map/transitions:\n" - ^ (LMap.show_map x.map) - ^ "\nNeq:\n" - ^ (Disequalities.show_neq x.diseq) - ^ "\nBlock diseqs:\n" - ^ show_conj(BlDis.to_conj x.bldis) - - (** Splits the conjunction into two groups: the first one contains all equality propositions, - and the second one contains all inequality propositions. *) - let split conj = List.fold_left (fun (pos,neg,bld) -> function - | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg,bld) - | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg,bld) - | BlNequal (t1,t2) -> (pos,neg,(t1,t2)::bld)) ([],[],[]) conj - - (** - returns {uf, set, map, min_repr}, where: - - - `uf` = empty union find structure where the elements are all subterms occuring in the conjunction. - - - `set` = set of all subterms occuring in the conjunction. - - - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t'). - - - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. - *) - let init_cc conj = - let (set, map) = SSet.subterms_of_conj conj in - let uf = SSet.elements set |> - TUF.init in - {uf; set; map; diseq = Disequalities.empty; bldis=BlDis.empty} - - (** closure of disequalities *) - let congruence_neq cc neg = - try - let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in - (* getting args of dereferences *) - let uf,cmap,arg = Disequalities.get_args cc.uf in - (* taking implicit dis-equalities into account *) - let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap,arg) in - let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) neq_list in - (* taking explicit dis-equalities into account *) - let neq_list = Disequalities.init_list_neq uf neg in - let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in - if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); - Some {uf; set=cc.set; map=cc.map; diseq=neq; bldis=cc.bldis} - with Unsat -> None - - (** - parameters: (uf, map, new_repr) equalities. - - returns updated (uf, map, new_repr), where: - - `uf` is the new union find data structure after having added all equalities. - - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - - `new_repr` maps each term that changed its representative term to the new representative. - It can be given as a parameter to `update_bldis` in order to update the representatives in the block disequalities. - - Throws "Unsat" if a contradiction is found. - *) - let rec closure (uf, map, new_repr) = function - | [] -> (uf, map, new_repr) - | (t1, t2, r)::rest -> - (let v1, r1, uf = TUF.find uf t1 in - let v2, r2, uf = TUF.find uf t2 in - let sizet1, sizet2 = T.get_size t1, T.get_size t2 in - if not (Z.equal sizet1 sizet2) then - (if M.tracing then M.trace "c2po" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); - closure (uf, map, new_repr) rest) else - if T.equal v1 v2 then - (* t1 and t2 are in the same equivalence class *) - if Z.equal r1 Z.(r2 + r) then closure (uf, map, new_repr) rest - else raise Unsat - else let diff_r = Z.(r2 - r1 + r) in - let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) - (* update new_representative *) - let new_repr = if T.equal v v1 then TMap.add v2 v new_repr else TMap.add v1 v new_repr in - (* update map *) - let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with - | None, _, false -> map, rest - | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest - | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest - | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) - | Some imap1, Some imap2, true -> (* v1 is new root *) - (* zmap describes args of Deref *) - let r0 = Z.(r2-r1+r) in (* difference between roots *) - (* we move all entries of imap2 to imap1 *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = match LMap.zmap_find_opt r' zmap with - | None -> rest - | Some v'' -> (v', v'', Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) - (imap1,rest) infl2 in - LMap.remove v2 (LMap.add v zmap map), rest - | Some imap1, Some imap2, false -> (* v2 is new root *) - let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = - match LMap.zmap_find_opt r' zmap with - | None -> rest - | Some v'' -> (v', v'',Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in - LMap.remove v1 (LMap.add v zmap map), rest - in - closure (uf, map, new_repr) rest - ) - - (** Update block disequalities with the new representatives, *) - let update_bldis new_repr bldis = - let find_new_root t1 = match TMap.find_opt t1 new_repr with - | None -> t1 - | Some v -> v - in - let disequalities = BlDis.to_conj bldis - in (*TODO maybe optimize?, and maybe use this also for removing terms *) - let add_bl_dis new_diseq = function - | BlNequal (t1,t2) -> BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) - | _-> new_diseq - in - List.fold add_bl_dis BlDis.empty disequalities - - (** - Parameters: cc conjunctions. - - returns updated cc, where: - - - `uf` is the new union find data structure after having added all equalities. - - - `set` doesn't change - - - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - - - `diseq` are the disequalities between the new representatives. - - - `bldis` are the block disequalities between the new representatives. - - Throws "Unsat" if a contradiction is found. - *) - let closure cc conjs = - match cc with - | None -> None - | Some cc -> - let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in - let bldis = update_bldis new_repr cc.bldis in - congruence_neq {uf; set = cc.set; map; diseq=cc.diseq; bldis=bldis} [] - - (** Adds the block disequalities to the cc, but first rewrites them such that - they are disequalities between representatives. The cc should already contain - all the terms that are present in those block disequalities. - *) - let rec add_normalized_bl_diseqs cc = function - | [] -> cc - | (t1,t2)::bl_conjs -> - match cc with - | None -> None - | Some cc -> - let t1' = fst (TUF.find_no_pc cc.uf t1) in - let t2' = fst (TUF.find_no_pc cc.uf t2) in - if T.equal t1' t2' then None (*unsatisfiable*) - else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in - add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs - - (** Throws Unsat if the congruence is unsatisfiable.*) - let init_congruence conj = - let cc = init_cc conj in - (* propagating equalities through derefs *) - closure (Some cc) conj - - (** Returns None if the congruence is unsatisfiable.*) - let init_congruence_opt conj = - let cc = init_cc conj in - (* propagating equalities through derefs *) - match closure (Some cc) conj with - | exception Unsat -> None - | x -> Some x - - (** Add a term to the data structure. - - Returns (reference variable, offset), updated congruence closure *) - let rec insert cc t = - if SSet.mem t cc.set then - let v,z,uf = TUF.find cc.uf t in - (v,z), Some {cc with uf} - else - match t with - | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in - let set = SSet.add t cc.set in - (t, Z.zero), Some {cc with uf; set;} - | Deref (t', z, exp) -> - match insert cc t' with - | (v, r), None -> (v, r), None - | (v, r), Some cc -> - let set = SSet.add t cc.set in - match LMap.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in - let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)] - | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in - let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {uf; set; map; diseq = cc.diseq; bldis=cc.bldis} - - (** Add a term to the data structure. - - Returns (reference variable, offset), updated congruence closure *) - let insert cc t = - match cc with - | None -> (t, Z.zero), None - | Some cc -> insert cc t - - (** Add all terms in a specific set to the data structure. - - Returns updated cc. *) - let insert_set cc t_set = - SSet.fold (fun t cc -> snd (insert cc t)) t_set cc - - (** Returns true if t1 and t2 are equivalent. *) - let rec eq_query cc (t1,t2,r) = - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - if T.equal v1 v2 && Z.equal r1 Z.(r2 + r) then (true, cc) - else - (* If the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, - i.e. if t1' + z1 = t2' + z2. - This is useful when the dereferenced elements are not pointers. *) - if Z.equal r Z.zero then - match t1,t2 with - | Deref (t1', z1, _), Deref (t2', z2, _) -> - eq_query cc (t1', t2', Z.(z2 - z1)) - | _ -> (false, cc) - else (false,cc) - - let eq_query_opt cc (t1,t2,r) = - match cc with - | None -> false - | Some cc -> fst (eq_query cc (t1,t2,r)) - - let block_neq_query cc (t1,t2) = - (* we implicitly assume that &x != &y + z *) - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - match cc with - | None -> true - | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis - - (** Returns true if t1 and t2 are not equivalent. *) - let neq_query cc (t1,t2,r) = - (* we implicitly assume that &x != &y + z *) - if T.is_addr t1 && T.is_addr t2 then true else - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - (* implicit disequalities following from equalities *) - if T.equal v1 v2 then - if Z.(equal r1 (r2 + r)) then false - else true - else - match cc with - | None -> true - | Some cc -> (* implicit disequalities following from block disequalities *) - BlDis.map_set_mem t1 t2 cc.bldis || - (*explicit dsequalities*) - Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq - - (** Adds equalities to the data structure. - Throws "Unsat" if a contradiction is found. *) - let meet_conjs cc pos_conjs = - let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in - closure cc pos_conjs - in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res - - (** Adds propositions to the data structure. - Returns None if a contradiction is found. *) - let meet_conjs_opt conjs cc = - let pos_conjs, neg_conjs, bl_conjs = split conjs in - let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in - match insert_set (meet_conjs cc pos_conjs) terms_to_add with - | exception Unsat -> None - | Some cc -> let cc = congruence_neq cc neg_conjs in - add_normalized_bl_diseqs cc bl_conjs - | None -> None - - (** Add proposition t1 = t2 + r to the data structure. *) - let add_eq cc (t1, t2, r) = - let (v1, r1), cc = insert cc t1 in - let (v2, r2), cc = insert cc t2 in - let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in - cc - - (** adds block disequalities to cc: - fo each representative t in cc it adds the disequality bl(lterm) != bl(t)*) - let add_block_diseqs cc lterm = - match cc with - | None -> cc - | Some cc -> - let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in - Some {cc with bldis} - - (* Remove variables: *) - let remove_terms_from_eq predicate cc = - let rec insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in - (* start from all initial states that are still valid and find new representatives if necessary *) - (* new_reps maps each representative term to the new representative of the equivalence class *) - (*but new_reps contains an element but not necessarily the representative!!*) - let find_new_repr state old_rep old_z new_reps = - match LMap.find_opt old_rep new_reps with - | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps - | None -> if not @@ predicate old_rep then - old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) - (* the representative need to be removed from the data structure: state is the new repr.*) - state, Z.zero, TMap.add old_rep (state, old_z) new_reps in - let add_atom (new_reps, new_cc, reachable_old_reps) state = - let old_rep, old_z = TUF.find_no_pc cc.uf state in - let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in - let new_cc = insert_terms new_cc [state; new_rep] in - let new_cc = closure new_cc [(state, new_rep, new_z)] in - (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) - in - let new_reps, new_cc, reachable_old_reps = - SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some(init_cc [])),[]) cc.set in - let cmap = Disequalities.comp_map cc.uf in - (* breadth-first search of reachable states *) - let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = - let old_rep_s, old_z_s = TUF.find_no_pc cc.uf s_t in - let find_successor_in_set (z, term_set) = - let exception Found in - let res = ref None in - try - TSet.iter (fun t -> - match SSet.deref_term t Z.(s_z-z) cc.set with - | exception (T.UnsupportedCilExpression _) -> () - | successor -> if (not @@ predicate successor) then - (res := Some successor; raise Found) - else - () - ) term_set; !res - with Found -> !res - in - (* find successor term -> find any element in equivalence class that can be dereferenced *) - match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with - | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then - let new_cc = insert_terms new_cc [successor_term] in - match LMap.find_opt old_rep_s new_reps with - | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) - new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps - | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. - -> we choose a successor term *(t+z) for any - -> we need add the successor state to the list of states that still need to be visited - *) - TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps - else - (new_reps, new_cc, reachable_old_reps) - | None -> - (* the term cannot be dereferenced, so we won't add this transition. *) - (new_reps, new_cc, reachable_old_reps) - in - (* find all successors that are still reachable *) - let rec add_transitions new_reps new_cc = function - | [] -> new_reps, new_cc - | (old_rep, new_rep, z)::rest -> - let successors = LMap.successors old_rep cc.map in - let new_reps, new_cc, reachable_old_reps = - List.fold (add_transition (old_rep, new_rep,z)) (new_reps, new_cc, []) successors in - add_transitions new_reps new_cc (rest@reachable_old_reps) - in add_transitions new_reps new_cc - (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) - - (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. - Returns None if there are no elements in the same equivalence class as t before it was deleted.*) - let find_new_root new_reps uf v = - match TMap.find_opt v new_reps with - | None -> None - | Some (new_t, z1) -> - let t_rep, z2 = TUF.find_no_pc uf new_t in - Some (t_rep, Z.(z2-z1)) - - let remove_terms_from_diseq diseq new_reps cc = - let disequalities = Disequalities.get_disequalities diseq - in - let add_disequality new_diseq = function - | Nequal(t1,t2,z) -> - begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with - | Some (t1',z1'), Some (t2', z2') -> (t1', t2', Z.(z2'+z-z1'))::new_diseq - | _ -> new_diseq - end - | _-> new_diseq - in - let new_diseq = List.fold add_disequality [] disequalities - in congruence_neq cc new_diseq - - let remove_terms_from_bldis bldis new_reps cc = - let disequalities = BlDis.to_conj bldis - in - let add_bl_dis new_diseq = function - | BlNequal (t1,t2) -> - begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with - | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq (t1', t2') - | _ -> new_diseq - end - | _-> new_diseq - in - List.fold add_bl_dis BlDis.empty disequalities - - (** Remove terms from the data structure. - It removes all terms for which "predicate" is false, - while maintaining all equalities about variables that are not being removed.*) - let remove_terms predicate cc = - let old_cc = cc in - match remove_terms_from_eq predicate cc with - | new_reps, Some cc -> - begin match remove_terms_from_diseq old_cc.diseq new_reps cc with - | Some cc -> - let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - if M.tracing then M.trace "c2po" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" - (show_all old_cc) (show_all {uf=cc.uf; set = cc.set; map = cc.map; diseq=cc.diseq; bldis}); - Some {uf=cc.uf; set = cc.set; map = cc.map; diseq=cc.diseq; bldis} - | None -> None - end - | _,None -> None - - (* join *) - - let show_pmap pmap= - List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> - s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) - - let product_no_automata_over_terms cc1 cc2 terms = - let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in - let mappings = List.map - (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in - let r2, off2 = TUF.find_no_pc cc2.uf a in - (r1,r2,Z.(off2 - off1)), (a,off1)) (SSet.to_list terms) in - let add_term (cc, pmap) (new_element, (new_term, a_off)) = - match Map.find_opt new_element pmap with - | None -> cc, Map.add new_element (new_term, a_off) pmap - | Some (c, c1_off) -> - add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in - List.fold_left add_term (Some (init_cc []), Map.empty) mappings - - (** Here we do the join without using the automata, because apparently - we don't want to describe the automaton in the paper... - - We construct a new cc that contains the elements of cc1.set U cc2.set - and two elements are in the same equivalence class iff they are in the same eq. class - both in cc1 and in cc2. *) - let join_eq cc1 cc2 = - let terms = SSet.union cc1.set cc2.set in - product_no_automata_over_terms cc1 cc2 terms - - (** Same as join, but we only take the terms from the left argument. *) - let widen_eq cc1 cc2 = - product_no_automata_over_terms cc1 cc2 cc1.set - - (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. - - This is done by checking for each disequality if it is implied by both cc. *) - let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = - let _,diseq1,_ = split (Disequalities.get_disequalities diseq1) in - let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in - (* keep all disequalities from diseq1 that are implied by cc2 and - those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1) in - let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2) in - let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in - let res = congruence_neq cc (diseq1 @ diseq2) - in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res - - (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. - - This is done by checing for each block disequality if it is implied by both cc. *) - let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = - let bldiseq1 = BlDis.to_conj bldiseq1 in - let bldiseq2 = BlDis.to_conj bldiseq2 in - (* keep all disequalities from diseq1 that are implied by cc2 and - those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1) in - let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2) in - let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in - let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in - let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms - in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); - {cc with bldis} - - (* check for equality of two congruence closures *) - - (** Compares the equivalence classes of cc1 and those of cc2. *) - let equal_eq_classes cc1 cc2 = - let comp1, comp2 = Disequalities.comp_map cc1.uf, Disequalities.comp_map cc2.uf in - (* they should have the same number of equivalence classes *) - if TMap.cardinal comp1 <> TMap.cardinal comp2 then false else - (* compare each equivalence class of cc1 with the corresponding eq. class of cc2 *) - let compare_zmap_entry offset zmap2 (z, tset1) = - match ZMap.find_opt Z.(z+offset) zmap2 with - | None -> false - | Some tset2 -> SSet.equal tset1 tset2 - in - let compare_with_cc2_eq_class (rep1, zmap1) = - let rep2, offset = TUF.find_no_pc cc2.uf rep1 in - let zmap2 = TMap.find rep2 comp2 in - if ZMap.cardinal zmap2 <> ZMap.cardinal zmap1 then false else - List.for_all (compare_zmap_entry offset zmap2) (ZMap.bindings zmap1) - in - List.for_all compare_with_cc2_eq_class (TMap.bindings comp1) - - let equal_diseqs cc1 cc2 = - let normalize_diseqs (min_state1, min_state2, new_offset) = - if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) - else Nequal (min_state2, min_state1, Z.(-new_offset)) in - let rename_diseqs dis = match dis with - | Nequal (t1,t2,z) -> - let (min_state1, min_z1) = TUF.find_no_pc cc2.uf t1 in - let (min_state2, min_z2) = TUF.find_no_pc cc2.uf t2 in - let new_offset = Z.(-min_z2 + min_z1 + z) in - normalize_diseqs (min_state1, min_state2, new_offset) - | _ -> dis in - let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.map rename_diseqs (Disequalities.get_disequalities cc1.diseq) in - let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.filter_map (function | Nequal (t1,t2,z) -> Some (normalize_diseqs(t1,t2,z)) - | _ -> None) (Disequalities.get_disequalities cc2.diseq) in - List.equal T.equal_v_prop renamed_diseqs normalized_diseqs - - let equal_bldis cc1 cc2 = - let normalize_bldis (min_state1, min_state2) = - if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) - else BlNequal (min_state2, min_state1) in - let rename_bldis dis = match dis with - | BlNequal (t1,t2) -> - let min_state1, _ = TUF.find_no_pc cc2.uf t1 in - let min_state2, _ = TUF.find_no_pc cc2.uf t2 in - normalize_bldis (min_state1, min_state2) - | _ -> dis in - let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.map rename_bldis (BlDis.to_conj cc1.bldis) in - let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.map (function | Nequal (t1,t2,_) | Equal(t1,t2,_) | BlNequal (t1,t2) - -> (normalize_bldis(t1,t2))) (BlDis.to_conj cc2.bldis) in - List.equal T.equal_v_prop renamed_diseqs normalized_diseqs -end - -include CongruenceClosure (**Find out if two addresses are not equal by using the MayPointTo query*) module MayBeEqual = struct @@ -1176,7 +109,7 @@ module D = struct (** Convert to string *) let show x = match x with | None -> "⊥\n" - | Some x -> show_conj (get_normal_form x) + | Some x -> show_conj (get_conjunction x) let show_all = function | None -> "⊥\n" @@ -1207,7 +140,7 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} let init () = init_congruence [] @@ -1231,7 +164,7 @@ module D = struct else (if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in + let cc = fst(join_eq_no_automata a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) @@ -1251,7 +184,7 @@ module D = struct | Some a, Some b -> if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); - let cc = fst(widen_eq a b) in + let cc = fst(widen_eq_no_automata a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) @@ -1268,7 +201,7 @@ module D = struct | None, _ -> None | _, None -> None | Some a, b -> - match get_normal_form a with + match get_conjunction a with | [] -> b | a_conj -> meet_conjs_opt a_conj b @@ -1284,7 +217,7 @@ module D = struct | Some a, Some b -> let b_conj = List.filter (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) - (get_normal_form b) in + (get_conjunction b) in meet_conjs_opt b_conj (Some a) let pretty_diff () (x,y) = Pretty.dprintf "" diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7f7cb9ca09..bac0661cb3 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -127,6 +127,9 @@ module CongruenceClosure = struct list@list2 ) [] (ZMap.bindings imap) + (** Find all disequalities of the form t1 != z2-z1 + t2 + that can be inferred from equalities of the form *(z1 + t1) = *(z2 + t2). + *) let check_neq (_,arg) rest (v,zmap) = let zlist = ZMap.bindings zmap in fold_left2 (fun rest (r1,_) (r2,_) -> @@ -146,18 +149,19 @@ module CongruenceClosure = struct else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 ) rest zlist zlist + (** Find all disequalities of the form t1 != z2-z1 + t2 + that can be inferred from block equalities of the form bl( *(z1 + t1) ) = bl( *(z2 + t2) ). + *) let check_neq_bl (uf,arg) rest (t1, tset) = List.fold (fun rest t2 -> - if T.equal (fst@@TUF.find_no_pc_if_possible uf t1) (fst@@TUF.find_no_pc_if_possible uf t2) - then raise Unsat - else (* r1 <> r2 *) - let l1 = map_find_all t1 arg in - let l2 = map_find_all t2 arg in - fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if T.equal v1 v2 then if Z.equal r'1 r'2 - then raise Unsat - else rest - else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 + (* We know that r1 <> r2, otherwise it would be Unsat. *) + let l1 = map_find_all t1 arg in + let l2 = map_find_all t2 arg in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if T.equal v1 v2 then if Z.equal r'1 r'2 + then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 ) rest (TSet.to_list tset) (** Initialize the list of disequalities taking only implicit dis-equalities into account. @@ -227,6 +231,7 @@ module CongruenceClosure = struct (* collection of disequalities: * disequalities originating from different offsets of same root + * disequalities originating from block disequalities * stated disequalities * closure by collecting appropriate args for a disequality v1 != v2 +r for distinct roots v1,v2 @@ -272,6 +277,10 @@ module CongruenceClosure = struct Nequal (t1,t2,Z.(-z)) ) % bindings + (** For each disequality t1 != z + t2 we add all disequalities + that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', + then we add the disequaity t1' != z + z2 - z1 + t2'. + *) let element_closure diseqs cmap = let comp_closure (r1,r2,z) = let to_tuple_list = (*TODO this is not the best solution*) @@ -296,7 +305,12 @@ module CongruenceClosure = struct (* block disequalities *) module BlDis = struct - type t = TSet.t TMap.t [@@deriving eq, ord, hash] (* block disequalitites *) + (** Block disequalities: + a term t1 is mapped to a set of terms that have a different block than t1. + It is allowed to contain terms that are not present in the data structure, + so we shouldn't assume that all terms in bldis are present in the union find! + *) + type t = TSet.t TMap.t [@@deriving eq, ord, hash] let bindings = TMap.bindings let empty = TMap.empty @@ -311,28 +325,27 @@ module CongruenceClosure = struct | None -> TMap.add t1 (TSet.singleton t2) bldiseq | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq + (** Add disequalities bl(t1) != bl(t2) and bl(t2) != bl(t1). *) let add_block_diseq bldiseq (t1, t2) = add (add bldiseq t1 t2) t2 t1 (** params: - t1-> any term + t1-> a term that is NOT present in the data structure tlist: a list of representative terms - For each term t2 in tlist, it adds the disequality t1' != t2 to diseqs - where t1' is the representative of t1. - Except the block disequality t1' = t1' will not be added, even - if t1' is in tlist. + For each term t2 in tlist, it adds the disequality t1 != t2 to diseqs. *) let add_block_diseqs bldiseq uf t1 tlist = - let t1',_ = t1, t1 in - (* TODO: not a good idea: TUF.find_no_pc uf t1 in *) List.fold (fun bldiseq t2 -> - if T.equal t1' t2 then bldiseq - else add_block_diseq bldiseq (t1', t2)) bldiseq tlist + add_block_diseq bldiseq (t1, t2)) bldiseq tlist + (** For each block disequality bl(t1) != bl(t2) we add all disequalities + that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', + then we add the disequaity bl(t1') != bl(t2'). + *) let element_closure bldis cmap = let comp_closure = function | BlNequal (r1,r2) -> @@ -357,9 +370,29 @@ module CongruenceClosure = struct let map_set_mem v v' (map:t) = match TMap.find_opt v map with | None -> false | Some set -> TSet.mem v' set + + let filter_if (map:t) p = + TMap.filter_map (fun _ t_set -> + let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) map + + let filter_map f (diseq:t) = + TMap.filter_map + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) diseq + + let shift v r v' (map:t) = + match TMap.find_opt v' map with + | None -> map + | Some tset -> + TMap.remove v' (TMap.add v tset map) + + let term_set bldis = + TSet.of_enum (TMap.keys bldis) end - (** Set of subterms which are present in the current data structure. *) + (** Set of subterms which are present in the current data structure. + TODO: check if it is needed? Because this information is implicitly present in the union find data structure. *) module SSet = struct type t = TSet.t [@@deriving eq, ord, hash] @@ -411,6 +444,11 @@ module CongruenceClosure = struct | None -> Deref (t, z, T.dereference_exp exp z) | Some t -> t + (** Sometimes it's important to keep the dereferenced term, + even if it's not technically possible to dereference it from a point of view of the C types. + We still need the dereferenced term for he correctness of some algorithms, + and the resulting expression will never be used, so it doesn't need to be a + C expression hat makes sense. *) let deref_term_even_if_its_not_possible min_term z set = match deref_term min_term z set with | result -> result @@ -605,16 +643,53 @@ module CongruenceClosure = struct (* all propositions *) BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) + Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) + (** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) + let get_conjunction cc = + let normalize_equality (t1, t2, z) = + if T.equal t1 t2 && Z.(equal z zero) then None else + Some (Equal (t1, t2, z)) in + let conjunctions_of_atoms = + let atoms = SSet.get_atoms cc.set in + List.filter_map (fun atom -> + let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in + normalize_equality (atom, rep_state, rep_z) + ) atoms + in + let conjunctions_of_transitions = + let transitions = get_transitions (cc.uf, cc.map) in + List.filter_map (fun (z,s,(s',z')) -> + normalize_equality (SSet.deref_term_even_if_its_not_possible s z cc.set, s', z') + ) transitions in + (*disequalities*) + let disequalities = Disequalities.get_disequalities cc.diseq in + (* find disequalities between min_repr *) + let normalize_disequality (t1, t2, z) = + if T.compare t1 t2 < 0 then Nequal (t1, t2, z) + else Nequal (t2, t1, Z.(-z)) + in + if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); + let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in + (* block disequalities *) + let normalize_bldis t = match t with + | BlNequal (t1,t2) -> + if T.compare t1 t2 < 0 then BlNequal (t1, t2) + else BlNequal (t2, t1) + | _ -> t + in + let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in + (* all propositions *) + BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) + let show_all x = "Normal form:\n" ^ - show_conj((get_normal_form x)) ^ + show_conj((get_conjunction x)) ^ "Union Find partition:\n" ^ (TUF.show_uf x.uf) ^ "\nSubterm set:\n" ^ (SSet.show_set x.set) ^ "\nLookup map/transitions:\n" ^ (LMap.show_map x.map) - ^ "\nMinimal representatives:\n" - ^ (MRMap.show_min_rep x.min_repr) ^ "\nNeq:\n" ^ (Disequalities.show_neq x.diseq) ^ "\nBlock diseqs:\n" @@ -662,33 +737,31 @@ module CongruenceClosure = struct with Unsat -> None (** - parameters: (uf, map) equalities. + parameters: (uf, map, new_repr) equalities. - returns updated (uf, map, queue), where: + returns updated (uf, map, new_repr), where: `uf` is the new union find data structure after having added all equalities. `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - `queue` is a list of equivalence classes (represented by their representative) that have a new representative after the execution of this function. - It can be given as a parameter to `update_min_repr` in order to update the representatives in the representative map. - - `new_repr` -> maps each representative to its new representative after the union + `new_repr` maps each term that changed its representative term to the new representative. + It can be given as a parameter to `update_bldis` in order to update the representatives in the block disequalities. Throws "Unsat" if a contradiction is found. *) - let rec closure (uf, map, min_repr, new_repr) queue = function - | [] -> (uf, map, queue, min_repr, new_repr) + let rec closure (uf, map, new_repr) = function + | [] -> (uf, map, new_repr) | (t1, t2, r)::rest -> (let v1, r1, uf = TUF.find uf t1 in let v2, r2, uf = TUF.find uf t2 in let sizet1, sizet2 = T.get_size t1, T.get_size t2 in if not (Z.equal sizet1 sizet2) then (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); - closure (uf, map, min_repr, new_repr) queue rest) else + closure (uf, map, new_repr) rest) else if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) - if Z.equal r1 Z.(r2 + r) then closure (uf, map, min_repr, new_repr) queue rest + if Z.equal r1 Z.(r2 + r) then closure (uf, map, new_repr) rest else raise Unsat else let diff_r = Z.(r2 - r1 + r) in let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) @@ -723,17 +796,10 @@ module CongruenceClosure = struct in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in LMap.remove v1 (LMap.add v zmap map), rest in - (* update min_repr *) - let min_v1, min_v2 = MRMap.find v1 min_repr, MRMap.find v2 min_repr in - (* 'changed' is true if the new_min is different than the old min *) - let new_min, changed = if T.compare (fst min_v1) (fst min_v2) < 0 then (min_v1, not b) else (min_v2, b) in - let new_min = (fst new_min, if b then Z.(snd new_min - diff_r) else Z.(snd new_min + diff_r)) in - let removed_v = if b then v2 else v1 in - let min_repr = MRMap.remove removed_v (if changed then MRMap.add v new_min min_repr else min_repr) in - let queue = v :: queue in - closure (uf, map, min_repr, new_repr) queue rest + closure (uf, map, new_repr) rest ) + (** Update block disequalities with the new representatives, *) let update_bldis new_repr bldis = (* update block disequalities with the new representatives *) let find_new_root t1 = match TMap.find_opt t1 new_repr with @@ -743,31 +809,11 @@ module CongruenceClosure = struct let disequalities = BlDis.to_conj bldis in (*TODO maybe optimize?, and maybe use this also for removing terms *) let add_bl_dis new_diseq = function - | BlNequal (t1,t2) ->BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) + | BlNequal (t1,t2) -> BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) | _-> new_diseq in List.fold add_bl_dis BlDis.empty disequalities - let rec add_normalized_bl_diseqs cc = function - | [] -> cc - | (t1,t2)::bl_conjs -> - match cc with - | None -> None - | Some cc -> - let t1' = fst (TUF.find_no_pc cc.uf t1) in - let t2' = fst (TUF.find_no_pc cc.uf t2) in - if T.equal t1' t2' then None (*unsatisfiable*) - else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in - add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs - - let closure_no_min_repr cc conjs = - match cc with - | None -> None - | Some cc -> - let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in - let bldis = update_bldis new_repr cc.bldis in - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] - (** Parameters: cc conjunctions. @@ -779,7 +825,9 @@ module CongruenceClosure = struct - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - - `min_repr` maps each equivalence class to its minimal representative. + - `diseq` are the disequalities between the new representatives. + + - `bldis` are the block disequalities between the new representatives. Throws "Unsat" if a contradiction is found. *) @@ -787,12 +835,25 @@ module CongruenceClosure = struct match cc with | None -> None | Some cc -> - let (uf, map, queue, min_repr, new_repr) = closure (cc.uf, cc.map, cc.min_repr, TMap.empty) [] conjs in + let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in let bldis = update_bldis new_repr cc.bldis in - (* let min_repr, uf = MRMap.update_min_repr (uf, cc.set, map) min_repr queue in *) - let min_repr, uf = MRMap.compute_minimal_representatives (uf, cc.set, map) in - if M.tracing then M.trace "wrpointer" "closure minrepr: %s\n" (MRMap.show_min_rep min_repr); - congruence_neq {uf; set = cc.set; map; min_repr; diseq=cc.diseq; bldis=bldis} [] + congruence_neq {uf; set = cc.set; map; min_repr=cc.min_repr; diseq=cc.diseq; bldis=bldis} [] + + (** Adds the block disequalities to the cc, but first rewrites them such that + they are disequalities between representatives. The cc should already contain + all the terms that are present in those block disequalities. + *) + let rec add_normalized_bl_diseqs cc = function + | [] -> cc + | (t1,t2)::bl_conjs -> + match cc with + | None -> None + | Some cc -> + let t1' = fst (TUF.find_no_pc cc.uf t1) in + let t2' = fst (TUF.find_no_pc cc.uf t2) in + if T.equal t1' t2' then None (*unsatisfiable*) + else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in + add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs (** Throws Unsat if the congruence is unsatisfiable.*) let init_congruence conj = @@ -810,57 +871,42 @@ module CongruenceClosure = struct (** Add a term to the data structure. - Returns (reference variable, offset), updated (uf, set, map, min_repr), - and queue, that needs to be passed as a parameter to `update_min_repr`. - - `queue` is a list which contains all atoms that are present as subterms of t and that are not already present in the data structure. *) - let rec insert_no_min_repr cc t = + Returns (reference variable, offset), updated congruence closure *) + let rec insert cc t = if SSet.mem t cc.set then let v,z,uf = TUF.find cc.uf t in - (v,z), Some {cc with uf}, [] + (v,z), Some {cc with uf} else match t with | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in - let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in let set = SSet.add t cc.set in - (t, Z.zero), Some {cc with uf; set; min_repr;}, [t] + (t, Z.zero), Some {cc with uf; set;} | Deref (t', z, exp) -> - match insert_no_min_repr cc t' with - | (v, r), None, queue -> (v, r), None, [] - | (v, r), Some cc, queue -> - let min_repr = MRMap.add t (t, Z.zero) cc.min_repr in + match insert cc t' with + | (v, r), None -> (v, r), None + | (v, r), Some cc -> let set = SSet.add t cc.set in match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)], v::queue + (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map;min_repr=cc.min_repr; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)] | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {uf; set; map; min_repr; diseq = cc.diseq; bldis=cc.bldis}, v::queue + (t, Z.zero), Some {uf; set; map; min_repr=cc.min_repr; diseq = cc.diseq; bldis=cc.bldis} (** Add a term to the data structure. - Returns (reference variable, offset), updated (uf, set, map, min_repr) *) + Returns (reference variable, offset), updated congruence closure *) let insert cc t = match cc with | None -> (t, Z.zero), None - | Some cc -> - match insert_no_min_repr cc t with - | v, None, queue -> v, None - | v, Some cc, queue -> - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - v, Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} + | Some cc -> insert cc t (** Add all terms in a specific set to the data structure. - Returns updated (uf, set, map, min_repr). *) + Returns updated cc. *) let insert_set cc t_set = - match SSet.fold (fun t (cc, a_queue) -> let _, cc, queue = Option.map_default (fun cc -> insert_no_min_repr cc t) ((t, Z.zero), None, []) cc in (cc, queue @ a_queue) ) t_set (cc, []) with - | None, queue -> None - | Some cc, queue -> - (* update min_repr at the end for more efficiency *) - let min_repr, uf = MRMap.update_min_repr (cc.uf, cc.set, cc.map) cc.min_repr queue in - Some {uf; set = cc.set; map = cc.map; min_repr; diseq = cc.diseq; bldis=cc.bldis} + SSet.fold (fun t cc -> snd (insert cc t)) t_set cc (** Returns true if t1 and t2 are equivalent. *) let rec eq_query cc (t1,t2,r) = @@ -883,15 +929,13 @@ module CongruenceClosure = struct | None -> false | Some cc -> fst (eq_query cc (t1,t2,r)) - (*TODO there could be less code duplication *) let block_neq_query cc (t1,t2) = (* we implicitly assume that &x != &y + z *) - if T.is_addr t1 && T.is_addr t2 then true else - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - match cc with - | None -> true - | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + match cc with + | None -> true + | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = @@ -916,8 +960,10 @@ module CongruenceClosure = struct let meet_conjs cc pos_conjs = let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in closure cc pos_conjs - in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_normal_form res)) "None" res);res + in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_conjunction res)) "None" res);res + (** Adds propositions to the data structure. + Returns None if a contradiction is found. *) let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs, bl_conjs = split conjs in let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in @@ -935,7 +981,7 @@ module CongruenceClosure = struct cc (** adds block disequalities to cc: - fo each representative t in cc it adds the disequality bl(lterm)!=bl(t)*) + fo each representative t in cc it adds the disequality bl(lterm) != bl(t)*) let add_block_diseqs cc lterm = match cc with | None -> cc @@ -944,10 +990,8 @@ module CongruenceClosure = struct Some {cc with bldis} (* Remove variables: *) - let remove_terms_from_eq predicate cc = - let rec insert_terms cc = - function | [] -> cc | t::ts -> insert_terms (Option.bind cc (fun cc -> Tuple3.second (insert_no_min_repr cc t))) ts in + let rec insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in (* start from all initial states that are still valid and find new representatives if necessary *) (* new_reps maps each representative term to the new representative of the equivalence class *) (*but new_reps contains an element but not necessarily the representative!!*) @@ -962,7 +1006,7 @@ module CongruenceClosure = struct let old_rep, old_z = TUF.find_no_pc cc.uf state in let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in let new_cc = insert_terms new_cc [state; new_rep] in - let new_cc = closure_no_min_repr new_cc [(state, new_rep, new_z)] in + let new_cc = closure new_cc [(state, new_rep, new_z)] in (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) in let new_reps, new_cc, reachable_old_reps = @@ -991,7 +1035,7 @@ module CongruenceClosure = struct let new_cc = insert_terms new_cc [successor_term] in match LMap.find_opt old_rep_s new_reps with | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) - new_reps, closure_no_min_repr new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps + new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. -> we choose a successor term *(t+z) for any -> we need add the successor state to the list of states that still need to be visited @@ -1060,15 +1104,14 @@ module CongruenceClosure = struct begin match remove_terms_from_diseq old_cc.diseq new_reps cc with | Some cc -> let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - let min_repr, uf = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) - in if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" - (show_all old_cc) (show_all {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis}); - Some {uf; set = cc.set; map = cc.map; min_repr; diseq=cc.diseq; bldis} + if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" + (show_all old_cc) (show_all {uf=cc.uf; set = cc.set; map = cc.map; min_repr=cc.min_repr; diseq=cc.diseq; bldis}); + Some {uf=cc.uf; set = cc.set; map = cc.map; min_repr=cc.min_repr; diseq=cc.diseq; bldis} | None -> None end | _,None -> None - (* join *) + (* join version 1: by using the automaton *) let show_pmap pmap= List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> @@ -1109,7 +1152,38 @@ module CongruenceClosure = struct in add_edges_to_map pmap cc working_set - (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. *) + (* join version 2: just look at equivalence classes and not the automaton. *) + + let product_no_automata_over_terms cc1 cc2 terms = + let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in + let mappings = List.map + (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in + let r2, off2 = TUF.find_no_pc cc2.uf a in + (r1,r2,Z.(off2 - off1)), (a,off1)) (SSet.to_list terms) in + let add_term (cc, pmap) (new_element, (new_term, a_off)) = + match Map.find_opt new_element pmap with + | None -> cc, Map.add new_element (new_term, a_off) pmap + | Some (c, c1_off) -> + add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in + List.fold_left add_term (Some (init_cc []), Map.empty) mappings + + (** Here we do the join without using the automata, because apparently + we don't want to describe the automaton in the paper... + + We construct a new cc that contains the elements of cc1.set U cc2.set + and two elements are in the same equivalence class iff they are in the same eq. class + both in cc1 and in cc2. *) + let join_eq_no_automata cc1 cc2 = + let terms = SSet.union cc1.set cc2.set in + product_no_automata_over_terms cc1 cc2 terms + + (** Same as join, but we only take the terms from the left argument. *) + let widen_eq_no_automata cc1 cc2 = + product_no_automata_over_terms cc1 cc2 cc1.set + + (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. + + This is done by checking for each disequality if it is implied by both cc. *) let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = let _,diseq1,_ = split (Disequalities.get_disequalities diseq1) in let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in @@ -1121,7 +1195,9 @@ module CongruenceClosure = struct let res = congruence_neq cc (diseq1 @ diseq2) in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res - (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. *) + (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. + + This is done by checing for each block disequality if it is implied by both cc. *) let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = let bldiseq1 = BlDis.to_conj bldiseq1 in let bldiseq2 = BlDis.to_conj bldiseq2 in @@ -1135,4 +1211,60 @@ module CongruenceClosure = struct in (if M.tracing then M.trace "wrpointer-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); {cc with bldis} + (* Check for equality of two congruence closures, + by comparing the equivalence classes instead of computing the minimal_representative. *) + + (** Compares the equivalence classes of cc1 and those of cc2. *) + let equal_eq_classes cc1 cc2 = + let comp1, comp2 = Disequalities.comp_map cc1.uf, Disequalities.comp_map cc2.uf in + (* they should have the same number of equivalence classes *) + if TMap.cardinal comp1 <> TMap.cardinal comp2 then false else + (* compare each equivalence class of cc1 with the corresponding eq. class of cc2 *) + let compare_zmap_entry offset zmap2 (z, tset1) = + match ZMap.find_opt Z.(z+offset) zmap2 with + | None -> false + | Some tset2 -> SSet.equal tset1 tset2 + in + let compare_with_cc2_eq_class (rep1, zmap1) = + let rep2, offset = TUF.find_no_pc cc2.uf rep1 in + let zmap2 = TMap.find rep2 comp2 in + if ZMap.cardinal zmap2 <> ZMap.cardinal zmap1 then false else + List.for_all (compare_zmap_entry offset zmap2) (ZMap.bindings zmap1) + in + List.for_all compare_with_cc2_eq_class (TMap.bindings comp1) + + let equal_diseqs cc1 cc2 = + let normalize_diseqs (min_state1, min_state2, new_offset) = + if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) + else Nequal (min_state2, min_state1, Z.(-new_offset)) in + let rename_diseqs dis = match dis with + | Nequal (t1,t2,z) -> + let (min_state1, min_z1) = TUF.find_no_pc cc2.uf t1 in + let (min_state2, min_z2) = TUF.find_no_pc cc2.uf t2 in + let new_offset = Z.(-min_z2 + min_z1 + z) in + normalize_diseqs (min_state1, min_state2, new_offset) + | _ -> dis in + let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map rename_diseqs (Disequalities.get_disequalities cc1.diseq) in + let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.filter_map (function | Nequal (t1,t2,z) -> Some (normalize_diseqs(t1,t2,z)) + | _ -> None) (Disequalities.get_disequalities cc2.diseq) in + List.equal T.equal_v_prop renamed_diseqs normalized_diseqs + + let equal_bldis cc1 cc2 = + let normalize_bldis (min_state1, min_state2) = + if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) + else BlNequal (min_state2, min_state1) in + let rename_bldis dis = match dis with + | BlNequal (t1,t2) -> + let min_state1, _ = TUF.find_no_pc cc2.uf t1 in + let min_state2, _ = TUF.find_no_pc cc2.uf t2 in + normalize_bldis (min_state1, min_state2) + | _ -> dis in + let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map rename_bldis (BlDis.to_conj cc1.bldis) in + let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map (function | Nequal (t1,t2,_) | Equal(t1,t2,_) | BlNequal (t1,t2) + -> (normalize_bldis(t1,t2))) (BlDis.to_conj cc2.bldis) in + List.equal T.equal_v_prop renamed_diseqs normalized_diseqs end From f484cd21bc8cb6246fda20cac1a595d20e7f5fa4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 21:15:29 +0200 Subject: [PATCH 223/323] use MustBeSingleThreaded instead of IsEverMultithreaded --- src/analyses/singleThreadedLifter.ml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/analyses/singleThreadedLifter.ml b/src/analyses/singleThreadedLifter.ml index 39010ab2b2..5253caef56 100644 --- a/src/analyses/singleThreadedLifter.ml +++ b/src/analyses/singleThreadedLifter.ml @@ -6,7 +6,7 @@ module SingleThreadedLifter (S: MCPSpec) = struct include S - let is_multithreaded (ask:Queries.ask) = ask.f IsEverMultiThreaded + let is_multithreaded (ask:Queries.ask) = not @@ ask.f (MustBeSingleThreaded {since_start = true}) let query ctx = if is_multithreaded (ask_of_ctx ctx) then @@ -43,14 +43,11 @@ struct [D.top (),D.top ()] else enter ctx var_opt f args - (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t - expr funktionsaufruf*) let combine_env ctx var_opt expr f exprs t_context_opt t (ask: Queries.ask) = if is_multithreaded (ask_of_ctx ctx) then D.top () else combine_env ctx var_opt expr f exprs t_context_opt t ask - (*ctx.local is after combine_env, t callee*) let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = if is_multithreaded (ask_of_ctx ctx) then D.top () else From 0b8305c2e9108f659ae778b539d2e280085a22e5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 21:23:49 +0200 Subject: [PATCH 224/323] move the short-circuit after the match --- src/cdomains/c2poDomain.ml | 152 ++++++++++++++++++------------------- 1 file changed, 73 insertions(+), 79 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 0b61706a79..632d5b1721 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1187,25 +1187,22 @@ module D = struct let name () = "c2po" let equal x y = - if x == y then - true - else - let res = - match x,y with - | None, None -> true - | Some cc1, Some cc2 -> - if cc1 == cc2 then - true - else - (* add all terms to both elements *) - let terms = SSet.union (SSet.union cc1.set (BlDis.term_set cc1.bldis)) - (SSet.union cc2.set (BlDis.term_set cc2.bldis)) in - let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in - equal_eq_classes cc1 cc2 - && equal_diseqs cc1 cc2 - && equal_bldis cc1 cc2 - | _ -> false - in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res + let res = + match x,y with + | None, None -> true + | Some cc1, Some cc2 -> + if cc1 == cc2 then + true + else + (* add all terms to both elements *) + let terms = SSet.union (SSet.union cc1.set (BlDis.term_set cc1.bldis)) + (SSet.union cc2.set (BlDis.term_set cc2.bldis)) in + let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in + equal_eq_classes cc1 cc2 + && equal_diseqs cc1 cc2 + && equal_bldis cc1 cc2 + | _ -> false + in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} @@ -1218,70 +1215,67 @@ module D = struct | Some cc -> TUF.is_empty cc.uf let join a' b' = - if a' == b' then - a' - else - let res = - match a',b' with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if a == b then - a' - else - (if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) - in - if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" - (show_all res); - res - - let widen a b = - if a == b then - a - else - let res = - match a,b with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(widen_eq a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) - in - if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" - (show_all res); - res - - let meet a b = - if a == b then - a - else - match a,b with - | None, _ -> None - | _, None -> None - | Some a, b -> + let res = + match a',b' with + | None, b -> b + | a, None -> a + | Some a, Some b -> + if a == b then + a' + else + (if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(join_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) + in + if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" + (show_all res); + res + + let widen a' b' = + let res = + match a',b' with + | None, b -> b + | a, None -> a + | Some a, Some b -> + if a == b then + a' + else + (if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(widen_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) + in + if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" + (show_all res); + res + + let meet a' b' = + match a',b' with + | None, _ -> None + | _, None -> None + | Some a, Some b -> + if a == b then + a' + else match get_normal_form a with - | [] -> b - | a_conj -> meet_conjs_opt a_conj b + | [] -> b' + | a_conj -> meet_conjs_opt a_conj b' let leq x y = equal (meet x y) x - let narrow a b = - if a == b then - a - else - match a,b with - | None, _ -> None - | _, None -> None - | Some a, Some b -> + let narrow a' b' = + match a',b' with + | None, _ -> None + | _, None -> None + | Some a, Some b -> + if a == b then + a + else let b_conj = List.filter (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_normal_form b) in From 2b2e0a25835546de5802f4ac63438694e058e820 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 21:31:51 +0200 Subject: [PATCH 225/323] fix is_top: now it takes into account the disequalities --- src/cdomains/c2poDomain.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 632d5b1721..f745efc4a3 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -22,6 +22,7 @@ module CongruenceClosure = struct type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) let empty = TMap.empty + let is_empty = TMap.is_empty let remove = TMap.remove (** Returns a list of tuples, which each represent a disequality *) let bindings = @@ -317,6 +318,8 @@ module CongruenceClosure = struct let bindings = TMap.bindings let empty = TMap.empty + let is_empty = TMap.is_empty + let to_conj bldiseq = List.fold (fun list (t1, tset) -> TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list @@ -1212,7 +1215,8 @@ module D = struct let is_bot x = Option.is_none x let top () = empty () let is_top = function None -> false - | Some cc -> TUF.is_empty cc.uf + | Some cc -> + TUF.is_empty cc.uf && Disequalities.is_empty cc.diseq && BlDis.is_empty cc.bldis let join a' b' = let res = From 79bbc07fcd60c456fbd719de36573504444371c7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 7 Jul 2024 21:37:18 +0200 Subject: [PATCH 226/323] fix code --- src/cdomains/c2poDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index f745efc4a3..4eac7dbc94 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1278,7 +1278,7 @@ module D = struct | _, None -> None | Some a, Some b -> if a == b then - a + a' else let b_conj = List.filter (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) From 965be40caf08d0c243da13dad513959e5885e465 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 10:44:02 +0200 Subject: [PATCH 227/323] moved MayBeEqual to CongruenceClosure.ml --- src/cdomains/congruenceClosure.ml | 95 +++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index bac0661cb3..331ca2f078 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1268,3 +1268,98 @@ module CongruenceClosure = struct -> (normalize_bldis(t1,t2))) (BlDis.to_conj cc2.bldis) in List.equal T.equal_v_prop renamed_diseqs normalized_diseqs end + + +(**Find out if two addresses are not equal by using the MayPointTo query*) +module MayBeEqual = struct + open CongruenceClosure + + module AD = Queries.AD + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} + let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) + let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) + + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} + let return_var var = T.aux_term_of_varinfo (return_varinfo var) + let return_lval var = Lval (Var (return_varinfo var), NoOffset) + + let ask_may_point_to (ask: Queries.ask) exp = + match ask.f (MayPointTo exp) with + | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () + | res -> res + + let may_point_to_all_equal_terms ask exp cc term offset = + let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + let equal_terms = List.filter valid_term comp in + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); + let intersect_query_result res (term,z) = + let next_query = + match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with + | exception (T.UnsupportedCilExpression _) -> AD.top() + | res -> if AD.is_bot res then AD.top() else res + in + AD.meet res next_query in + List.fold intersect_query_result (AD.top()) equal_terms + + (**Find out if two addresses are possibly equal by using the MayPointTo query. *) + let may_point_to_address (ask:Queries.ask) adresses t2 off cc = + match T.to_cil_sum off (T.to_cil t2) with + | exception (T.UnsupportedCilExpression _) -> true + | exp2 -> + let mpt1 = adresses in + let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in + let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res + + let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = + if T.equal t1 t2 then true else + let exp1 = T.to_cil t1 in + let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in + let res = may_point_to_address ask mpt1 t2 off cc in + if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" + AD.pretty mpt1 (T.show t1) d_plainexp exp1; res + + let rec may_be_equal ask cc s t1 t2 = + let there_is_an_overlap s s' diff = + if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) + in + match t1, t2 with + | Deref (t, z,_), Deref (v, z',_) -> + let (q', z1') = TUF.find_no_pc cc.uf v in + let (q, z1) = TUF.find_no_pc cc.uf t in + let s' = T.get_size t2 in + let diff = Z.(-z' - z1 + z1' + z) in + (* If they are in the same equivalence class and they overlap, then they are equal *) + (if T.equal q' q && there_is_an_overlap s s' diff then true + else + (* If we have a disequality, then they are not equal *) + if neq_query (Some cc) (t,v,Z.(z'-z)) then false else + (* or if we know that they are not equal according to the query MayPointTo*) + if GobConfig.get_bool "ana.c2po.askbase" then (may_point_to_same_address ask t v Z.(z' - z) cc) + else true) + || (may_be_equal ask cc s t1 v) + | Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) + | Addr _ , _ | Aux _, _ -> T.is_subterm t1 t2 + + (**Returns true iff by assigning to t1, the value of t2 could change. + The parameter s is the size in bits of the variable t1 we are assigning to. *) + let may_be_equal ask cc s t1 t2 = + match cc with + | None -> false + | Some cc -> + let res = (may_be_equal ask cc s t1 t2) in + if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + res + + let rec may_point_to_one_of_these_adresses ask adresses cc t2 = + match t2 with + | Deref (v, z',_) -> + (may_point_to_address ask adresses v z' cc) + || (may_point_to_one_of_these_adresses ask adresses cc v) + | Addr _ | Aux _ -> false + +end From cbd7bf6f41930e83ca1372e68bc15d3c4a43ae43 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 10:45:24 +0200 Subject: [PATCH 228/323] merged wrpointerDomain with c2poDomain --- src/cdomains/c2poDomain.ml | 161 +++++------- src/cdomains/weaklyRelationalPointerDomain.ml | 229 ------------------ 2 files changed, 55 insertions(+), 335 deletions(-) delete mode 100644 src/cdomains/weaklyRelationalPointerDomain.ml diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 02fb425a4f..244d320d86 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1,103 +1,12 @@ -(** It's the same as wrpointer but less precise and hopefully more efficient? *) +(** Domain for weakly relational pointer analysis. *) -open CongruenceClosure -include CongruenceClosure open Batteries open GoblintCil module Var = CilType.Varinfo - -(**Find out if two addresses are not equal by using the MayPointTo query*) -module MayBeEqual = struct - - module AD = Queries.AD - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} - let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) - let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="c2po__@return"} - let return_var var = T.aux_term_of_varinfo (return_varinfo var) - let return_lval var = Lval (Var (return_varinfo var), NoOffset) - - let ask_may_point_to (ask: Queries.ask) exp = - match ask.f (MayPointTo exp) with - | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () - | res -> res - - let may_point_to_all_equal_terms ask exp cc term offset = - let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" - d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); - let intersect_query_result res (term,z) = - let next_query = - match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with - | exception (T.UnsupportedCilExpression _) -> AD.top() - | res -> if AD.is_bot res then AD.top() else res - in - AD.meet res next_query in - List.fold intersect_query_result (AD.top()) equal_terms - - (**Find out if two addresses are possibly equal by using the MayPointTo query. *) - let may_point_to_address (ask:Queries.ask) adresses t2 off cc = - match T.to_cil_sum off (T.to_cil t2) with - | exception (T.UnsupportedCilExpression _) -> true - | exp2 -> - let mpt1 = adresses in - let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" - AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res - - let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = - if T.equal t1 t2 then true else - let exp1 = T.to_cil t1 in - let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in - let res = may_point_to_address ask mpt1 t2 off cc in - if M.tracing && res then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" - AD.pretty mpt1 (T.show t1) d_plainexp exp1; res - - let rec may_be_equal ask cc s t1 t2 = - let there_is_an_overlap s s' diff = - if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) - in - match t1, t2 with - | Deref (t, z,_), Deref (v, z',_) -> - let (q', z1') = TUF.find_no_pc cc.uf v in - let (q, z1) = TUF.find_no_pc cc.uf t in - let s' = T.get_size t2 in - let diff = Z.(-z' - z1 + z1' + z) in - (* If they are in the same equivalence class and they overlap, then they are equal *) - (if T.equal q' q && there_is_an_overlap s s' diff then true - else - (* If we have a disequality, then they are not equal *) - if neq_query (Some cc) (t,v,Z.(z'-z)) then false else - (* or if we know that they are not equal according to the query MayPointTo*) - if GobConfig.get_bool "ana.c2po.askbase" then (may_point_to_same_address ask t v Z.(z' - z) cc) - else true) - || (may_be_equal ask cc s t1 v) - | Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) - | Addr _ , _ | Aux _, _ -> T.is_subterm t1 t2 - - (**Returns true iff by assigning to t1, the value of t2 could change. - The parameter s is the size in bits of the variable t1 we are assigning to. *) - let may_be_equal ask cc s t1 t2 = - match cc with - | None -> false - | Some cc -> - let res = (may_be_equal ask cc s t1 t2) in - if M.tracing then M.tracel "c2po-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; - res - - let rec may_point_to_one_of_these_adresses ask adresses cc t2 = - match t2 with - | Deref (v, z',_) -> - (may_point_to_address ask adresses v z' cc) - || (may_point_to_one_of_these_adresses ask adresses cc v) - | Addr _ | Aux _ -> false - -end +open CongruenceClosure +open CongruenceClosure +module M = Messages +module Var = CilType.Varinfo module D = struct @@ -117,9 +26,10 @@ module D = struct include Printable.SimpleShow(struct type t = domain let show = show end) - let name () = "c2po" + let name () = "wrpointer" - let equal x y = + + let equal_standard x y = if x == y then true else @@ -140,6 +50,20 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res + + let equal_min_repr x y = + if x == y then + true + else + let res = match x, y with + | Some x, Some y -> + (T.props_equal (get_normal_form x) (get_normal_form y)) + | None, None -> true + | _ -> false + in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + + let equal = if (*TODO*) true then equal_standard else equal_min_repr + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} let init () = init_congruence [] @@ -150,7 +74,27 @@ module D = struct let is_top = function None -> false | Some cc -> TUF.is_empty cc.uf - let join a' b' = + let join_automaton a b = + if a == b then + a + else + let res = + match a,b with + | None, b -> b + | a, None -> a + | Some a, Some b -> + if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(join_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) + in + if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" + (show_all res); + res + + let join_eq_classes a' b' = if a' == b' then a' else @@ -173,7 +117,9 @@ module D = struct (show_all res); res - let widen a b = + let join = if (*TODO*) true then join_eq_classes else join_automaton + + let widen_eq_classes a b = if a == b then a else @@ -193,6 +139,8 @@ module D = struct (show_all res); res + let widen = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";if (*TODO*) true then join else widen_eq_classes + let meet a b = if a == b then a @@ -224,11 +172,12 @@ module D = struct let printXml f x = match x with | Some x -> - BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" + BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) + (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) | None -> BatPrintf.fprintf f "\nbottom\n\n" @@ -236,14 +185,14 @@ module D = struct It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = - if M.tracing then M.trace "c2po" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = - if M.tracing then M.trace "c2po" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.bind cc (remove_terms (T.contains_variable vars)) (** Remove terms from the data structure. @@ -251,20 +200,20 @@ module D = struct except the global vars are also keeped (when vstorage = static), while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = - if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = - if M.tracing then M.trace "c2po" "remove_may_equal_terms: %s\n" (T.show term); + if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = - if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; + if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) end diff --git a/src/cdomains/weaklyRelationalPointerDomain.ml b/src/cdomains/weaklyRelationalPointerDomain.ml deleted file mode 100644 index 4c7f3aaa61..0000000000 --- a/src/cdomains/weaklyRelationalPointerDomain.ml +++ /dev/null @@ -1,229 +0,0 @@ -(** Domain for weakly relational pointer analysis. *) - -open Batteries -open GoblintCil -module Var = CilType.Varinfo -module CC = CongruenceClosure -include CC.CongruenceClosure -module M = Messages -module T = CC.T - -(**Find out if two addresses are not equal by using the MayPointTo query*) -module MayBeEqual = struct - - module AD = Queries.AD - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} - let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) - let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} - let return_var var = T.aux_term_of_varinfo (return_varinfo var) - let return_lval var = Lval (Var (return_varinfo var), NoOffset) - - let ask_may_point_to (ask: Queries.ask) exp = - match ask.f (MayPointTo exp) with - | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () - | res -> res - - let may_point_to_all_equal_terms ask exp cc term offset = - let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" - d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); - let intersect_query_result res (term,z) = - let next_query = - match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with - | exception (T.UnsupportedCilExpression _) -> AD.top() - | res -> if AD.is_bot res then AD.top() else res - in - AD.meet res next_query in - List.fold intersect_query_result (AD.top()) equal_terms - - (**Find out if two addresses are possibly equal by using the MayPointTo query. *) - let may_point_to_address (ask:Queries.ask) adresses t2 off cc = - match T.to_cil_sum off (T.to_cil t2) with - | exception (T.UnsupportedCilExpression _) -> true - | exp2 -> - let mpt1 = adresses in - let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" - AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res - - let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = - if T.equal t1 t2 then true else - let exp1 = T.to_cil t1 in - let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in - let res = may_point_to_address ask mpt1 t2 off cc in - if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" - AD.pretty mpt1 (T.show t1) d_plainexp exp1; res - - let rec may_be_equal ask cc s t1 t2 = - let there_is_an_overlap s s' diff = - if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) - in - match t1, t2 with - | CC.Deref (t, z,_), CC.Deref (v, z',_) -> - let (q', z1') = TUF.find_no_pc cc.uf v in - let (q, z1) = TUF.find_no_pc cc.uf t in - let s' = T.get_size t2 in - let diff = Z.(-z' - z1 + z1' + z) in - (* If they are in the same equivalence class and they overlap, then they are equal *) - (if T.equal q' q && there_is_an_overlap s s' diff then true - else - (* If we have a disequality, then they are not equal *) - if neq_query (Some cc) (t,v,Z.(z'-z)) then false else - (* or if we know that they are not equal according to the query MayPointTo*) - (may_point_to_same_address ask t v Z.(z' - z) cc)) - || (may_be_equal ask cc s t1 v) - | CC.Deref _, _ -> false (* The value of addresses or auxiliaries never change when we overwrite the memory*) - | CC.Addr _ , _ | CC.Aux _, _ -> T.is_subterm t1 t2 - - (**Returns true iff by assigning to t1, the value of t2 could change. - The parameter s is the size in bits of the variable t1 we are assigning to. *) - let may_be_equal ask cc s t1 t2 = - match cc with - | None -> false - | Some cc -> - let res = (may_be_equal ask cc s t1 t2) in - if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; - res - - let rec may_point_to_one_of_these_adresses ask adresses cc t2 = - match t2 with - | CC.Deref (v, z',_) -> - (may_point_to_address ask adresses v z' cc) - || (may_point_to_one_of_these_adresses ask adresses cc v) - | CC.Addr _ | CC.Aux _ -> false - -end - -module D = struct - - include Printable.StdLeaf - - type domain = t option [@@deriving ord, hash] - type t = domain [@@deriving ord, hash] - - (** Convert to string *) - let show x = match x with - | None -> "⊥\n" - | Some x -> show_conj (get_normal_form x) - - let show_all = function - | None -> "⊥\n" - | Some x -> show_all x - - include Printable.SimpleShow(struct type t = domain let show = show end) - - let name () = "wrpointer" - - let equal x y = - if x == y then - true - else - let res = match x, y with - | Some x, Some y -> - (T.props_equal (get_normal_form x) (get_normal_form y)) - | None, None -> true - | _ -> false - in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res - - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} - - let init () = init_congruence [] - - let bot () = None - let is_bot x = Option.is_none x - let top () = empty () - let is_top = function None -> false - | Some cc -> TUF.is_empty cc.uf - - let join a b = - if a == b then - a - else - let res = - match a,b with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) - in - if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" - (show_all res); - res - - let widen a b = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";join a b - - let meet a b = - if a == b then - a - else - match a,b with - | None, _ -> None - | _, None -> None - | Some a, b -> - let a_conj = get_normal_form a in - meet_conjs_opt a_conj b - - let leq x y = equal (meet x y) x - - let narrow = meet - - let pretty_diff () (x,y) = Pretty.dprintf "" - - let printXml f x = match x with - | Some x -> - BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" - (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) - (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) - (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) - (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) - (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) - (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) - | None -> BatPrintf.fprintf f "\nbottom\n\n" - - (** Remove terms from the data structure. - It removes all terms for which "var" is a subterm, - while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variable var cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) - - (** Remove terms from the data structure. - It removes all terms which contain one of the "vars", - while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (T.contains_variable vars)) - - (** Remove terms from the data structure. - It removes all terms which do not contain one of the "vars", - except the global vars are also keeped (when vstorage = static), - while maintaining all equalities about variables that are not being removed.*) - let remove_terms_not_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) - - (** Remove terms from the data structure. - It removes all terms that may be changed after an assignment to "term".*) - let remove_may_equal_terms ask s term cc = - if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); - let cc = snd (insert cc term) in - Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) - - (** Remove terms from the data structure. - It removes all terms that may point to the same address as "tainted".*) - let remove_tainted_terms ask address cc = - if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) - -end From abeb2a224912b2bb600cad75a05b1bb3a9b5bbc7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 10:48:06 +0200 Subject: [PATCH 229/323] merge wrpointerAnalysis and c2poAnalysis --- src/analyses/c2poAnalysis.ml | 44 ++-- .../weaklyRelationalPointerAnalysis.ml | 223 ------------------ 2 files changed, 22 insertions(+), 245 deletions(-) delete mode 100644 src/analyses/weaklyRelationalPointerAnalysis.ml diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index b1b95afd6d..cfe0547eca 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -1,10 +1,10 @@ -(** A 2-pointer analysis for C. I made this in a few days so please don't judge the code quality. ([2cpo])*) +(** A Weakly-Relational Pointer Analysis. The analysis can infer equalities and disequalities between terms which are built from pointer variables, with the addition of constants and dereferencing. ([wrpointer])*) open Analyses open GoblintCil open C2poDomain -module CC = CongruenceClosure -open CC +open CongruenceClosure +open CongruenceClosure open Batteries open SingleThreadedLifter @@ -15,14 +15,14 @@ struct module D = D module C = D - let name () = "c2po" + let name () = "wrpointer" let startcontext () = D.empty () (* find reachable variables in a function *) let reachable_from_args ctx args = let res = List.fold (fun vs e -> vs @ (ctx.ask (ReachableFrom e) |> Queries.AD.to_var_may)) [] args in - if M.tracing then M.tracel "c2po-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res + if M.tracing then M.tracel "wrpointer-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, @@ -34,11 +34,11 @@ struct | x::xs, _, [] -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None | _, y::ys, [] -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None | _ -> None (*there should never be block disequalities here...*) - in if M.tracing then M.trace "c2po" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" + in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res (* let query_may_point_to ctx t e = - if M.tracing then M.trace "c2po-query" "may-point-to %a!" + if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" d_exp e; match T.of_cil (ask_of_ctx ctx) e with | Some term, Some offset -> @@ -49,7 +49,7 @@ struct let valid_term (t,z) = T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" + if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); let intersect_query_result res (term,z) = let next_query = @@ -60,7 +60,7 @@ struct in MayBeEqual.AD.meet res next_query in List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms - in if M.tracing then M.trace "c2po-query" "may-point-to %a : %a. Is bot: %b\n" + in if M.tracing then M.trace "wrpointer-query" "may-point-to %a : %a. Is bot: %b\n" d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res end | _ -> @@ -89,7 +89,7 @@ struct (* Definite assignment *) | s, lterm, (Some term, Some offset) -> let dummy_var = MayBeEqual.dummy_var lval_t in - if M.tracing then M.trace "c2po-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); + if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> @@ -103,14 +103,14 @@ struct let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in - if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res + if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in let res = meet_conjs_opt valid_props ctx.local in if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" + if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" d_exp e pos (show_conj valid_props); res @@ -127,7 +127,7 @@ struct | Some e -> assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e | None -> ctx.local - in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res + in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res let add_new_block t ask lval = @@ -155,13 +155,13 @@ struct | None -> ctx.local | Some varin -> - if M.tracing then M.trace "c2po-malloc" + if M.tracing then M.trace "wrpointer-malloc" "SPECIAL MALLOC: exp = %a; var_opt = Some (%a); v = %a; " d_exp exp d_lval varin d_lval (Var v, NoOffset); add_new_block ctx.local (ask_of_ctx ctx) varin end | _ -> ctx.local - let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } + let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } (*First all local variables of the function are duplicated (by negating their ID), @@ -172,13 +172,13 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in - if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); + if M.tracing then M.trace "wrpointer-function" "ENTER2: result: %s\n" (D.show new_state); [ctx.local, new_state] (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t @@ -192,25 +192,25 @@ struct (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = (* find out the tainted variables from startState *) ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) in - if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; + if M.tracing then M.trace "wrpointer-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; let local = D.remove_tainted_terms ask tainted state_with_assignments in let t = D.meet local t in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); + if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in let t = D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t - in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t + in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t let startstate v = D.top () let threadenter ctx ~multiple lval f args = [D.top ()] diff --git a/src/analyses/weaklyRelationalPointerAnalysis.ml b/src/analyses/weaklyRelationalPointerAnalysis.ml deleted file mode 100644 index 0f0d933b76..0000000000 --- a/src/analyses/weaklyRelationalPointerAnalysis.ml +++ /dev/null @@ -1,223 +0,0 @@ -(** A Weakly-Relational Pointer Analysis. The analysis can infer equalities and disequalities between terms which are built from pointer variables, with the addition of constants and dereferencing. ([wrpointer])*) - -open Analyses -open GoblintCil -open WeaklyRelationalPointerDomain -module CC = CongruenceClosure -open CC.CongruenceClosure -open Batteries -open SingleThreadedLifter - -module Spec = -struct - include DefaultSpec - include Analyses.IdentitySpec - module D = D - module C = D - - let name () = "wrpointer" - let startcontext () = D.empty () - - (* find reachable variables in a function *) - let reachable_from_args ctx args = - let res = - List.fold (fun vs e -> vs @ (ctx.ask (ReachableFrom e) |> Queries.AD.to_var_may)) [] args in - if M.tracing then M.tracel "wrpointer-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res - - (* Returns Some true if we know for sure that it is true, - and Some false if we know for sure that it is false, - and None if we don't know anyhing. *) - let eval_guard ask t e = - let prop_list = T.prop_of_cil ask e true in - let res = match split prop_list with - | [], [], [] -> None - | x::xs, _, [] -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None - | _, y::ys, [] -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None - | _ -> None (*there should never be block disequalities here...*) - in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" - d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res - - (* let query_may_point_to ctx t e = - if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" - d_exp e; - match T.of_cil (ask_of_ctx ctx) e with - | Some term, Some offset -> - begin match insert t term with - | _,None -> MayBeEqual.AD.top() - | _,Some cc -> - let res = let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" - d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); - let intersect_query_result res (term,z) = - let next_query = - let ctx = {ctx with local=Some (init_cc [])} in - match MayBeEqual.ask_may_point_to (ask_of_ctx ctx) (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with - | exception (T.UnsupportedCilExpression _) -> MayBeEqual.AD.top() - | res -> if MayBeEqual.AD.is_bot res then MayBeEqual.AD.top() else res - in - MayBeEqual.AD.meet res next_query in - List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms - in if M.tracing then M.trace "wrpointer-query" "may-point-to %a : %a. Is bot: %b\n" - d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res - end - | _ -> - MayBeEqual.AD.top() *) - - let query ctx (type a) (q: a Queries.t): a Queries.result = - let open Queries in - match q with - | EvalInt e -> begin match eval_guard (ask_of_ctx ctx) ctx.local e with - | None -> Result.top q - | Some res -> - let ik = Cilfacade.get_ikind_exp e in - ID.of_bool ik res - end - (* TODO Invariant. - | Queries.Invariant context -> get_normal_form context*) - (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) - | _ -> Result.top q - - let assign_lval t ask lval expr = - (* ignore assignments to values that are not 64 bits *) (*TODO what if there is a cast*) - let lval_t = typeOfLval lval in - match T.get_element_size_in_bits lval_t, T.of_lval ask lval, T.of_cil ask expr with - (* Indefinite assignment *) - | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t - (* Definite assignment *) - | s, lterm, (Some term, Some offset) -> - let dummy_var = MayBeEqual.dummy_var lval_t in - if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); - t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> - D.remove_may_equal_terms ask s lterm |> - meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo lval_t - | exception (T.UnsupportedCilExpression _) -> D.top () - (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. - We have to forget all the information we had. - This should almost never happen. - Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) - | _ -> D.top () - - let assign ctx lval expr = - let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in - if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res - - let branch ctx e pos = - let props = T.prop_of_cil (ask_of_ctx ctx) e pos in - let valid_props = T.filter_valid_pointers props in - let res = meet_conjs_opt valid_props ctx.local in - if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" - d_exp e pos (show_conj valid_props); - res - - let body ctx f = ctx.local (*DONE*) - - let assign_return ask t return_var expr = - (* the return value is not stored on the heap, therefore we don't need to remove any terms *) - match T.of_cil ask expr with - | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] t - | _ -> t - - let return ctx exp_opt f = - let res = match exp_opt with - | Some e -> - assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e - | None -> ctx.local - in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res - - - let add_new_block t ask lval = - (* ignore assignments to values that are not 64 bits *) - let lval_t = typeOfLval lval in - match T.get_element_size_in_bits lval_t, T.of_lval ask lval with - (* Indefinite assignment *) - | s, lterm -> - (* let t = D.remove_may_equal_terms ask s lterm t in - -> not necessary because this is always a new fresh variable in goblint *) - add_block_diseqs t lterm - (* Definite assignment *) - | exception (T.UnsupportedCilExpression _) -> D.top () - - (** var_opt is the variable we assign to. It has type lval. v=malloc.*) - let special ctx var_opt v exprs = - let desc = LibraryFunctions.find v in - match desc.special exprs with - | Assert { exp; refine; _ } -> if not refine then - ctx.local - else - branch ctx exp true - | Malloc exp -> (*exp is the size of the malloc'ed block*) - begin match var_opt with - | None -> - ctx.local - | Some varin -> - if M.tracing then M.trace "wrpointer-malloc" - "SPECIAL MALLOC: exp = %a; var_opt = Some (%a); v = %a; " d_exp exp d_lval varin d_lval (Var v, NoOffset); - add_new_block ctx.local (ask_of_ctx ctx) varin - end - | _ -> ctx.local - - let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } - let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } - - (*First all local variables of the function are duplicated (by negating their ID), - then we remember the value of each local variable at the beginning of the function - by using the analysis startState. This way we can infer the relations between the - local variables of the caller and the pointers that were modified by the function. *) - let enter ctx var_opt f args = - (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = T.filter_valid_pointers (List.map (fun v -> CC.Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in - let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); - (* remove callee vars that are not reachable and not global *) - let reachable_variables = - f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args - in - let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in - if M.tracing then M.trace "wrpointer-function" "ENTER2: result: %s\n" (D.show new_state); - [ctx.local, new_state] - - (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t - expr funktionsaufruf*) - let combine_env ctx var_opt expr f exprs t_context_opt t (ask: Queries.ask) = - ctx.local - - (*ctx.local is after combine_env, t callee*) - let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = - let og_t = t in - (* assign function parameters to duplicated values *) - let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); - (*remove all variables that were tainted by the function*) - let tainted = (* find out the tainted variables from startState *) - ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) - in - if M.tracing then M.trace "wrpointer-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; - let local = D.remove_tainted_terms ask tainted state_with_assignments in - let t = D.meet local t in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); - let t = match var_opt with - | None -> t - | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) - in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); - let local_vars = f.sformals @ f.slocals in - let duplicated_vars = List.map duplicated_variable f.sformals in - let t = - D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t - in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t - - let startstate v = D.top () - let threadenter ctx ~multiple lval f args = [D.top ()] - let threadspawn ctx ~multiple lval f args fctx = D.top() - let exitstate v = D.top () - -end - -let _ = - MCP.register_analysis ~dep:["startState"; "taintPartialContexts"] (module SingleThreadedLifter(Spec) : MCPSpec) From 2b4fc1fc96e00a8a9066fd1501a99857352dc548 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 11:01:59 +0200 Subject: [PATCH 230/323] rename everything to c2po --- conf/svcomp-wrpointer.json | 148 ------------------ src/analyses/c2poAnalysis.ml | 40 ++--- src/cdomains/c2poDomain.ml | 20 +-- src/cdomains/congruenceClosure.ml | 30 ++-- src/cdomains/unionFind.ml | 16 +- src/goblint_lib.ml | 2 - tests/regression/82-wrpointer/01-simple.c | 20 --- tests/regression/82-wrpointer/02-rel-simple.c | 70 --------- .../82-wrpointer/03-function-call.c | 29 ---- .../regression/82-wrpointer/04-remove-vars.c | 23 --- tests/regression/82-wrpointer/05-branch.c | 47 ------ .../82-wrpointer/06-invertible-assignment.c | 17 -- .../82-wrpointer/07-invertible-assignment2.c | 22 --- .../82-wrpointer/08-simple-assignment.c | 15 -- .../82-wrpointer/09-different-offsets.c | 20 --- .../82-wrpointer/10-different-types.c | 38 ----- tests/regression/82-wrpointer/11-array.c | 21 --- .../regression/82-wrpointer/12-rel-function.c | 22 --- .../regression/82-wrpointer/13-experiments.c | 42 ----- tests/regression/82-wrpointer/14-join.c | 23 --- .../82-wrpointer/15-arrays-structs.c | 62 -------- tests/regression/82-wrpointer/16-loops.c | 28 ---- tests/regression/82-wrpointer/17-join2.c | 21 --- .../82-wrpointer/18-complicated-join.c | 25 --- .../82-wrpointer/19-disequalities.c | 40 ----- .../82-wrpointer/20-self-pointing-struct.c | 21 --- tests/regression/82-wrpointer/21-global-var.c | 40 ----- tests/regression/82-wrpointer/22-join-diseq.c | 37 ----- .../82-wrpointer/23-function-deref.c | 25 --- .../24-disequalities-small-example.c | 12 -- .../82-wrpointer/25-struct-circular.c | 28 ---- tests/regression/82-wrpointer/26-join3.c | 45 ------ .../regression/82-wrpointer/27-join-diseq2.c | 39 ----- .../regression/82-wrpointer/28-return-value.c | 16 -- tests/regression/82-wrpointer/29-widen.c | 25 --- .../regression/83-c2po/18-complicated-join.c | 14 +- 36 files changed, 61 insertions(+), 1082 deletions(-) delete mode 100644 conf/svcomp-wrpointer.json delete mode 100644 tests/regression/82-wrpointer/01-simple.c delete mode 100644 tests/regression/82-wrpointer/02-rel-simple.c delete mode 100644 tests/regression/82-wrpointer/03-function-call.c delete mode 100644 tests/regression/82-wrpointer/04-remove-vars.c delete mode 100644 tests/regression/82-wrpointer/05-branch.c delete mode 100644 tests/regression/82-wrpointer/06-invertible-assignment.c delete mode 100644 tests/regression/82-wrpointer/07-invertible-assignment2.c delete mode 100644 tests/regression/82-wrpointer/08-simple-assignment.c delete mode 100644 tests/regression/82-wrpointer/09-different-offsets.c delete mode 100644 tests/regression/82-wrpointer/10-different-types.c delete mode 100644 tests/regression/82-wrpointer/11-array.c delete mode 100644 tests/regression/82-wrpointer/12-rel-function.c delete mode 100644 tests/regression/82-wrpointer/13-experiments.c delete mode 100644 tests/regression/82-wrpointer/14-join.c delete mode 100644 tests/regression/82-wrpointer/15-arrays-structs.c delete mode 100644 tests/regression/82-wrpointer/16-loops.c delete mode 100644 tests/regression/82-wrpointer/17-join2.c delete mode 100644 tests/regression/82-wrpointer/18-complicated-join.c delete mode 100644 tests/regression/82-wrpointer/19-disequalities.c delete mode 100644 tests/regression/82-wrpointer/20-self-pointing-struct.c delete mode 100644 tests/regression/82-wrpointer/21-global-var.c delete mode 100644 tests/regression/82-wrpointer/22-join-diseq.c delete mode 100644 tests/regression/82-wrpointer/23-function-deref.c delete mode 100644 tests/regression/82-wrpointer/24-disequalities-small-example.c delete mode 100644 tests/regression/82-wrpointer/25-struct-circular.c delete mode 100644 tests/regression/82-wrpointer/26-join3.c delete mode 100644 tests/regression/82-wrpointer/27-join-diseq2.c delete mode 100644 tests/regression/82-wrpointer/28-return-value.c delete mode 100644 tests/regression/82-wrpointer/29-widen.c diff --git a/conf/svcomp-wrpointer.json b/conf/svcomp-wrpointer.json deleted file mode 100644 index e7cd14068a..0000000000 --- a/conf/svcomp-wrpointer.json +++ /dev/null @@ -1,148 +0,0 @@ -{ - "ana": { - "sv-comp": { - "enabled": true, - "functions": true - }, - "int": { - "def_exc": true, - "enums": false, - "interval": true - }, - "float": { - "interval": true - }, - "activated": [ - "base", - "threadid", - "threadflag", - "threadreturn", - "mallocWrapper", - "mutexEvents", - "mutex", - "access", - "race", - "escape", - "expRelation", - "mhp", - "assert", - "symb_locks", - "region", - "thread", - "threadJoins", - "wrpointer", - "startState", - "taintPartialContexts" - ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], - "context": { - "widen": false - }, - "malloc": { - "wrappers": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", - "kzalloc", - - "ldv_malloc", - - "kzalloc_node", - "ldv_zalloc", - "kmalloc_array", - "kcalloc", - - "ldv_xmalloc", - "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" - ] - }, - "base": { - "arrays": { - "domain": "partitioned" - } - }, - "race": { - "free": false, - "call": false - }, - "autotune": { - "enabled": true, - "activated": [ - "singleThreaded", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "congruence", - "octagon", - "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } - } diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index cfe0547eca..d630b373c7 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -1,4 +1,4 @@ -(** A Weakly-Relational Pointer Analysis. The analysis can infer equalities and disequalities between terms which are built from pointer variables, with the addition of constants and dereferencing. ([wrpointer])*) +(** A Weakly-Relational Pointer Analysis. The analysis can infer equalities and disequalities between terms which are built from pointer variables, with the addition of constants and dereferencing. ([c2po])*) open Analyses open GoblintCil @@ -15,14 +15,14 @@ struct module D = D module C = D - let name () = "wrpointer" + let name () = "c2po" let startcontext () = D.empty () (* find reachable variables in a function *) let reachable_from_args ctx args = let res = List.fold (fun vs e -> vs @ (ctx.ask (ReachableFrom e) |> Queries.AD.to_var_may)) [] args in - if M.tracing then M.tracel "wrpointer-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res + if M.tracing then M.tracel "c2po-reachable" "reachable vars: %s\n" (List.fold_left (fun s v -> s ^v.vname ^"; ") "" res); res (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, @@ -34,11 +34,11 @@ struct | x::xs, _, [] -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None | _, y::ys, [] -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None | _ -> None (*there should never be block disequalities here...*) - in if M.tracing then M.trace "wrpointer" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" + in if M.tracing then M.trace "c2po" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res (* let query_may_point_to ctx t e = - if M.tracing then M.trace "wrpointer-query" "may-point-to %a!" + if M.tracing then M.trace "c2po-query" "may-point-to %a!" d_exp e; match T.of_cil (ask_of_ctx ctx) e with | Some term, Some offset -> @@ -49,7 +49,7 @@ struct let valid_term (t,z) = T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); let intersect_query_result res (term,z) = let next_query = @@ -60,7 +60,7 @@ struct in MayBeEqual.AD.meet res next_query in List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms - in if M.tracing then M.trace "wrpointer-query" "may-point-to %a : %a. Is bot: %b\n" + in if M.tracing then M.trace "c2po-query" "may-point-to %a : %a. Is bot: %b\n" d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res end | _ -> @@ -89,7 +89,7 @@ struct (* Definite assignment *) | s, lterm, (Some term, Some offset) -> let dummy_var = MayBeEqual.dummy_var lval_t in - if M.tracing then M.trace "wrpointer-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); + if M.tracing then M.trace "c2po-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> @@ -103,14 +103,14 @@ struct let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in - if M.tracing then M.trace "wrpointer-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res + if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in let res = meet_conjs_opt valid_props ctx.local in if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "wrpointer" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" + if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" d_exp e pos (show_conj valid_props); res @@ -127,7 +127,7 @@ struct | Some e -> assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e | None -> ctx.local - in if M.tracing then M.trace "wrpointer-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res + in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res let add_new_block t ask lval = @@ -155,13 +155,13 @@ struct | None -> ctx.local | Some varin -> - if M.tracing then M.trace "wrpointer-malloc" + if M.tracing then M.trace "c2po-malloc" "SPECIAL MALLOC: exp = %a; var_opt = Some (%a); v = %a; " d_exp exp d_lval varin d_lval (Var v, NoOffset); add_new_block ctx.local (ask_of_ctx ctx) varin end | _ -> ctx.local - let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } + let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } (*First all local variables of the function are duplicated (by negating their ID), @@ -172,13 +172,13 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "wrpointer-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in - if M.tracing then M.trace "wrpointer-function" "ENTER2: result: %s\n" (D.show new_state); + if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); [ctx.local, new_state] (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t @@ -192,25 +192,25 @@ struct (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = (* find out the tainted variables from startState *) ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) in - if M.tracing then M.trace "wrpointer-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; + if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; let local = D.remove_tainted_terms ask tainted state_with_assignments in let t = D.meet local t in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); let t = match var_opt with | None -> t | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) in - if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in let t = D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t - in if M.tracing then M.trace "wrpointer-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t + in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t let startstate v = D.top () let threadenter ctx ~multiple lval f args = [D.top ()] diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 244d320d86..bd2f4202c4 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -26,7 +26,7 @@ module D = struct include Printable.SimpleShow(struct type t = domain let show = show end) - let name () = "wrpointer" + let name () = "c2po" let equal_standard x y = @@ -60,7 +60,7 @@ module D = struct (T.props_equal (get_normal_form x) (get_normal_form y)) | None, None -> true | _ -> false - in if M.tracing then M.trace "wrpointer-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res let equal = if (*TODO*) true then equal_standard else equal_min_repr @@ -83,14 +83,14 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> - if M.tracing then M.tracel "wrpointer-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); let cc = fst(join_eq a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) in - if M.tracing then M.tracel "wrpointer-join" "JOIN. JOIN: %s\n" + if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); res @@ -139,7 +139,7 @@ module D = struct (show_all res); res - let widen = if M.tracing then M.trace "wrpointer-join" "WIDEN\n";if (*TODO*) true then join else widen_eq_classes + let widen = if M.tracing then M.trace "c2po-join" "WIDEN\n";if (*TODO*) true then join else widen_eq_classes let meet a b = if a == b then @@ -185,14 +185,14 @@ module D = struct It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); + if M.tracing then M.trace "c2po" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + if M.tracing then M.trace "c2po" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.bind cc (remove_terms (T.contains_variable vars)) (** Remove terms from the data structure. @@ -200,20 +200,20 @@ module D = struct except the global vars are also keeped (when vstorage = static), while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = - if M.tracing then M.trace "wrpointer" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = - if M.tracing then M.trace "wrpointer" "remove_may_equal_terms: %s\n" (T.show term); + if M.tracing then M.trace "c2po" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) (** Remove terms from the data structure. It removes all terms that may point to the same address as "tainted".*) let remove_tainted_terms ask address cc = - if M.tracing then M.tracel "wrpointer-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; + if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) end diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 331ca2f078..01dda5e173 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -533,7 +533,7 @@ module CongruenceClosure = struct - The map with the minimal representatives - The union find tree. This might have changed because of path compression. *) let compute_minimal_representatives (uf, set, map) = - if M.tracing then M.trace "wrpointer" "compute_minimal_representatives\n"; + if M.tracing then M.trace "c2po" "compute_minimal_representatives\n"; let atoms = SSet.get_atoms set in (* process all atoms in increasing order *) let uf_ref = ref uf in @@ -620,7 +620,7 @@ module CongruenceClosure = struct if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) else Nequal (min_state2, min_state1, Z.(-new_offset)) in - if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); + if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in (* block disequalities *) let normalize_bldis t = match t with @@ -669,7 +669,7 @@ module CongruenceClosure = struct if T.compare t1 t2 < 0 then Nequal (t1, t2, z) else Nequal (t2, t1, Z.(-z)) in - if M.tracing then M.trace "wrpointer-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); + if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in (* block disequalities *) let normalize_bldis t = match t with @@ -732,7 +732,7 @@ module CongruenceClosure = struct (* taking explicit dis-equalities into account *) let neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in - if M.tracing then M.trace "wrpointer-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); + if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=cc.bldis} with Unsat -> None @@ -757,7 +757,7 @@ module CongruenceClosure = struct let v2, r2, uf = TUF.find uf t2 in let sizet1, sizet2 = T.get_size t1, T.get_size t2 in if not (Z.equal sizet1 sizet2) then - (if M.tracing then M.trace "wrpointer" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); + (if M.tracing then M.trace "c2po" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); closure (uf, map, new_repr) rest) else if T.equal v1 v2 then (* t1 and t2 are in the same equivalence class *) @@ -960,7 +960,7 @@ module CongruenceClosure = struct let meet_conjs cc pos_conjs = let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in closure cc pos_conjs - in if M.tracing then M.trace "wrpointer-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_conjunction res)) "None" res);res + in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_conjunction res)) "None" res);res (** Adds propositions to the data structure. Returns None if a contradiction is found. *) @@ -1104,7 +1104,7 @@ module CongruenceClosure = struct begin match remove_terms_from_diseq old_cc.diseq new_reps cc with | Some cc -> let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - if M.tracing then M.trace "wrpointer" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" + if M.tracing then M.trace "c2po" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" (show_all old_cc) (show_all {uf=cc.uf; set = cc.set; map = cc.map; min_repr=cc.min_repr; diseq=cc.diseq; bldis}); Some {uf=cc.uf; set = cc.set; map = cc.map; min_repr=cc.min_repr; diseq=cc.diseq; bldis} | None -> None @@ -1193,7 +1193,7 @@ module CongruenceClosure = struct let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2) in let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in let res = congruence_neq cc (diseq1 @ diseq2) - in (if M.tracing then match res with | Some r -> M.trace "wrpointer-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res + in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. @@ -1208,7 +1208,7 @@ module CongruenceClosure = struct let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms - in (if M.tracing then M.trace "wrpointer-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); + in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); {cc with bldis} (* Check for equality of two congruence closures, @@ -1275,11 +1275,11 @@ module MayBeEqual = struct open CongruenceClosure module AD = Queries.AD - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="wrpointer__@dummy"} + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="wrpointer__@return"} + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="c2po__@return"} let return_var var = T.aux_term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) @@ -1293,7 +1293,7 @@ module MayBeEqual = struct let valid_term (t,z) = T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "wrpointer-query" "may-point-to %a -> equal terms: %s" + if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); let intersect_query_result res (term,z) = let next_query = @@ -1312,7 +1312,7 @@ module MayBeEqual = struct let mpt1 = adresses in let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in - if M.tracing then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" + if M.tracing then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = @@ -1320,7 +1320,7 @@ module MayBeEqual = struct let exp1 = T.to_cil t1 in let mpt1 = may_point_to_all_equal_terms ask exp1 cc t1 Z.zero in let res = may_point_to_address ask mpt1 t2 off cc in - if M.tracing && res then M.tracel "wrpointer-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" + if M.tracing && res then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" AD.pretty mpt1 (T.show t1) d_plainexp exp1; res let rec may_be_equal ask cc s t1 t2 = @@ -1352,7 +1352,7 @@ module MayBeEqual = struct | None -> false | Some cc -> let res = (may_be_equal ask cc s t1 t2) in - if M.tracing then M.tracel "wrpointer-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + if M.tracing then M.tracel "c2po-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res let rec may_point_to_one_of_these_adresses ask adresses cc t2 = diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index efd63a4a5e..79776ecd27 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -287,7 +287,7 @@ module T = struct List.filter (function | Equal(t1,t2,_)| Nequal(t1,t2,_) |BlNequal(t1,t2)-> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) let dereference_exp exp offset = - if M.tracing then M.trace "wrpointer-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); + if M.tracing then M.trace "c2po-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); let res = let find_field cinfo = try @@ -310,7 +310,7 @@ module T = struct | TComp (cinfo, _) -> add_index_to_exp exp (find_field cinfo) | _ -> Lval (Mem (CastE (TPtr(TVoid[],[]), to_cil_sum offset exp)), NoOffset) in if check_valid_pointer res then res else raise (UnsupportedCilExpression "not a pointer variable") - in if M.tracing then M.trace "wrpointer-deref" "deref result: %a" d_exp res;res + in if M.tracing then M.trace "c2po-deref" "deref result: %a" d_exp res;res let get_size = get_size_in_bits % type_of_term @@ -385,8 +385,8 @@ module T = struct end in (if M.tracing then match res with - | exception (UnsupportedCilExpression s) -> M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s - | t -> M.trace "wrpointer-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show t)) + | exception (UnsupportedCilExpression s) -> M.trace "c2po-cil-conversion" "unsupported exp: %a\n%s\n" d_plainlval lval s + | t -> M.trace "c2po-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show t)) ;res (** Converts the negated expresion to a term if neg = true. @@ -404,12 +404,12 @@ module T = struct | exception GoblintCil__Errormsg.Error | true -> None, None | false -> let res = match of_cil_neg ask neg (Cil.constFold false e) with - | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "wrpointer-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; + | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "c2po-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; None, None | t, z -> t, Some z in (if M.tracing && not neg then match res with - | None, Some z -> M.trace "wrpointer-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) - | Some t, Some z -> M.trace "wrpointer-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); + | None, Some z -> M.trace "c2po-cil-conversion" "constant exp: %a --> %s\n" d_plainexp e (Z.to_string z) + | Some t, Some z -> M.trace "c2po-cil-conversion" "exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); | _ -> ()); res (** Convert the expression to a term, @@ -422,7 +422,7 @@ module T = struct let exp = to_cil t in if check_valid_pointer exp then Some t, Some z - else (if M.tracing then M.trace "wrpointer-cil-conversion" "invalid exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); + else (if M.tracing then M.trace "c2po-cil-conversion" "invalid exp: %a --> %s + %s\n" d_plainexp e (show t) (Z.to_string z); None, None) | t, z -> t, z diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index e5f2932b6c..3ce71b1fad 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -92,7 +92,6 @@ module Malloc_null = Malloc_null module MemLeak = MemLeak module UseAfterFree = UseAfterFree module MemOutOfBounds = MemOutOfBounds -module WeaklyRelationalPointerAnalysis = WeaklyRelationalPointerAnalysis module C2poAnalysis = C2poAnalysis (** {2 Concurrency} @@ -278,7 +277,6 @@ module StackDomain = StackDomain module CongruenceClosure = CongruenceClosure module UnionFind = UnionFind -module WeaklyRelationalPointerDomain = WeaklyRelationalPointerDomain module C2poDomain = C2poDomain (** {2 Testing} diff --git a/tests/regression/82-wrpointer/01-simple.c b/tests/regression/82-wrpointer/01-simple.c deleted file mode 100644 index abfbe7d655..0000000000 --- a/tests/regression/82-wrpointer/01-simple.c +++ /dev/null @@ -1,20 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -void main(void) { - int *i; - int **j; - j = (int**)malloc(sizeof(int*)+7); - *(j + 3) = (int *)malloc(sizeof(int)); - int *k; - i = *(j + 3); - *j = k; - - __goblint_check(**j == *k); - __goblint_check(i == *(j + 3)); - - j = &k + 1; - - __goblint_check(j == &k); // FAIL -} diff --git a/tests/regression/82-wrpointer/02-rel-simple.c b/tests/regression/82-wrpointer/02-rel-simple.c deleted file mode 100644 index bc3adff210..0000000000 --- a/tests/regression/82-wrpointer/02-rel-simple.c +++ /dev/null @@ -1,70 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include -#include - -int main(void) { - int *i = (int *)malloc(sizeof(int)); - int ***j = (int ***)malloc(sizeof(int) * 4); - int **j2 = (int **)malloc(sizeof(int)); - int **j23 = (int **)malloc(sizeof(int)); - *j = j2; - *(j + 3) = j23; - int *j3 = (int *)malloc(sizeof(int)); - int *j33 = (int *)malloc(sizeof(int)); - *j2 = j3; - **(j + 3) = j33; - *j3 = 4; - *j33 = 5; - int *k = i; - *k = 3; - // j --> *j=j2 --> **j=j3 --> ***j=|4| - // (j+3) --> j23 --> j33 --> |5| - // k=i --> |3| - - // printf("***j = %d\n", ***j); // 4 - // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 - // printf("*i = %d\n", *i); // 3 - // printf("*k = %d\n", *k); // 3 - // printf("\n"); - - __goblint_check(*j23 == j33); - __goblint_check(*j2 == j3); - __goblint_check(*i == *k); - - i = **(j + 3); - - // j --> *j=j2 --> **j=j3 --> ***j=|4| - // (j+3) --> j23 --> j33=i --> |5| - // k --> |3| - - // printf("***j = %d\n", ***j); // 4 - // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 - // printf("*i = %d\n", *i); // 5 - // printf("*k = %d\n", *k); // 3 - // printf("\n"); - - __goblint_check(*j23 == j33); - __goblint_check(*j2 == j3); - __goblint_check(*i == *j33); - - *j = &k; - - // j2 --> j3 --> |4| - // (j+3) --> j23 --> j33=i --> |5| - // j --> *j --> k --> |3| - - // printf("***j = %d\n", ***j); // 3 - // printf("***(j + 3) = %d\n", ***(j + 3)); // 5 - // printf("*i = %d\n", *i); // 5 - // printf("*k = %d\n", *k); // 3 - // printf("**j2 = %d\n", **j2); // 4 - - __goblint_check(*j23 == j33); - __goblint_check(*j2 == j3); - __goblint_check(**j == k); - - // not assignable: &k = *j; - - return 0; -} diff --git a/tests/regression/82-wrpointer/03-function-call.c b/tests/regression/82-wrpointer/03-function-call.c deleted file mode 100644 index 759ab4bc0c..0000000000 --- a/tests/regression/82-wrpointer/03-function-call.c +++ /dev/null @@ -1,29 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include -#include - -int *i; -int **j; - -int *f(int **a, int *b) { return *a; } - -int *g(int **a, int *b) { - a = (int **)malloc(sizeof(int *)); - return *a; -} - -int main(void) { - - j = (int **)malloc(sizeof(int *)); - *j = (int *)malloc(sizeof(int)); - int *k = f(j, i); - - __goblint_check(k == *j); - - k = g(j, i); - - __goblint_check(k == *j); // UNKNOWN! - - return 0; -} diff --git a/tests/regression/82-wrpointer/04-remove-vars.c b/tests/regression/82-wrpointer/04-remove-vars.c deleted file mode 100644 index be228c0cb3..0000000000 --- a/tests/regression/82-wrpointer/04-remove-vars.c +++ /dev/null @@ -1,23 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -int *f(int **j) { - int *i = (int *)malloc(sizeof(int)); - - *j = i; - - return i; -} - -int main(void) { - int *i; - int **j; - j = (int**)malloc(sizeof(int*)); - *j = (int *)malloc(sizeof(int)); - int *k = f(j); - - __goblint_check(k == *j); - - return 0; -} diff --git a/tests/regression/82-wrpointer/05-branch.c b/tests/regression/82-wrpointer/05-branch.c deleted file mode 100644 index c313cf117e..0000000000 --- a/tests/regression/82-wrpointer/05-branch.c +++ /dev/null @@ -1,47 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -void main(void) { - int *i; - int **j; - int *k; - i = *(j + 3); - *j = k; - j = &k + 1; - int *f; - if (j != &k) { - f = k; - printf("branch2"); - __goblint_check(1); // reachable - } else { - f = i; - printf("branch1"); - __goblint_check(0); // NOWARN (unreachable) - } - - __goblint_check(f == k); - - j = &k; - if (j != &k) { - f = k; - printf("branch1"); - __goblint_check(0); // NOWARN (unreachable) - } else { - f = i; - printf("branch2"); - __goblint_check(1); // reachable - } - - __goblint_check(f == i); - - if (**j + *k * 23 - 2 * *k == 0 && j != &k) { - f = k; - printf("branch1"); - __goblint_check(0); // NOWARN (unreachable) - } else { - f = i; - printf("branch2"); - __goblint_check(1); // reachable - } -} diff --git a/tests/regression/82-wrpointer/06-invertible-assignment.c b/tests/regression/82-wrpointer/06-invertible-assignment.c deleted file mode 100644 index bbc03fa0dd..0000000000 --- a/tests/regression/82-wrpointer/06-invertible-assignment.c +++ /dev/null @@ -1,17 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include - -void main(void) { - long *i; - long **j; - long *k; - j = &k + 1; - j++; - __goblint_check(j == &k + 2); - - i = *(j + 3); - i++; - __goblint_check(i == *(j + 3) + 1); - j++; - __goblint_check(i == *(j + 2) + 1); -} diff --git a/tests/regression/82-wrpointer/07-invertible-assignment2.c b/tests/regression/82-wrpointer/07-invertible-assignment2.c deleted file mode 100644 index 8d79140c3b..0000000000 --- a/tests/regression/82-wrpointer/07-invertible-assignment2.c +++ /dev/null @@ -1,22 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -// example of the paper "2-Pointer Logic" by Seidl et al., Example 9, pag. 22 -#include -#include - -void main(void) { - long x; - long *z; - z = &x; - long y; - - y = -1 + x; - - __goblint_check(z == &x); - __goblint_check(y == -1 + x); - - *z = 1 + x; - - __goblint_check(&x == z); - __goblint_check(y == -2 + x); - -} diff --git a/tests/regression/82-wrpointer/08-simple-assignment.c b/tests/regression/82-wrpointer/08-simple-assignment.c deleted file mode 100644 index 69de57a618..0000000000 --- a/tests/regression/82-wrpointer/08-simple-assignment.c +++ /dev/null @@ -1,15 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -// example of the paper "2-Pointer Logic" by Seidl et al., pag. 21 -#include - -void main(void) { - long x; - long *z = -1 + &x; - - __goblint_check(z == -1 + &x); - - z = (long*) *(1 + z); - - __goblint_check(x == (long)z); - -} diff --git a/tests/regression/82-wrpointer/09-different-offsets.c b/tests/regression/82-wrpointer/09-different-offsets.c deleted file mode 100644 index b5e22bb247..0000000000 --- a/tests/regression/82-wrpointer/09-different-offsets.c +++ /dev/null @@ -1,20 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -struct Pair { - int *first; - int *second; -}; - -void main(void) { - int *x; - struct Pair p; - p.first = x; - - struct Pair p2; - p2.first = x; - - __goblint_check(p.first == p2.first); - -} diff --git a/tests/regression/82-wrpointer/10-different-types.c b/tests/regression/82-wrpointer/10-different-types.c deleted file mode 100644 index 522b6d45aa..0000000000 --- a/tests/regression/82-wrpointer/10-different-types.c +++ /dev/null @@ -1,38 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -void main(void) { - // no problem if they are all ints - int *ipt = (int *)malloc(sizeof(int)); - int *ipt2; - int i; - ipt = &i; - // *ipt: 0; i: 0 - __goblint_check(*ipt == i); - ipt2 = (int *)ipt; - *(ipt2 + 1) = 'a'; - // *ipt: 0; i: 0 - __goblint_check(*ipt == i); - - // long pointer is cast to char pointer -> *(cpt + 1) overwrites *lpt - long *lpt = (long *)malloc(sizeof(long)); - char *cpt; - long lo; - *lpt = lo; - // *lpt: 0; l: 0 - __goblint_check(*lpt == lo); - cpt = (char *)lpt; - *(cpt + 1) = 'a'; - - // *lpt: 24832; l: 0 - __goblint_check(*lpt == lo); // UNKNOWN! - - lo = 0; - *lpt = lo; - // *lpt: 0; l: 0 - __goblint_check(*lpt == lo); - *((char *)lpt + 1) = 'a'; - // *lpt: 24832; l: 0 - __goblint_check(*lpt == lo); // UNKNOWN! -} diff --git a/tests/regression/82-wrpointer/11-array.c b/tests/regression/82-wrpointer/11-array.c deleted file mode 100644 index 1b16488105..0000000000 --- a/tests/regression/82-wrpointer/11-array.c +++ /dev/null @@ -1,21 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -void main(void) { - int m[5]; - - int **j; - int *l; - j = (int **)malloc(sizeof(int *) + 7); - j[3] = (int *)malloc(sizeof(int)); - int *k; - l = j[3]; - j[0] = k; - j[2] = m; - - __goblint_check(**j == *k); - __goblint_check(l == *(j + 3)); - __goblint_check(j[2] == m); - -} diff --git a/tests/regression/82-wrpointer/12-rel-function.c b/tests/regression/82-wrpointer/12-rel-function.c deleted file mode 100644 index f4e97e858a..0000000000 --- a/tests/regression/82-wrpointer/12-rel-function.c +++ /dev/null @@ -1,22 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include -#include - -void *f(int **a, int **b) { - int *j; - int **i = &j; - j = (int *)malloc(sizeof(int) * 2); - *a = j; - *b = *i + 1; -} - -int main(void) { - int **c = (int**)malloc(sizeof(int*)); - int **d = (int**)malloc(sizeof(int*));; - f(c, d); - - __goblint_check(*d == *c + 1); - - return 0; -} diff --git a/tests/regression/82-wrpointer/13-experiments.c b/tests/regression/82-wrpointer/13-experiments.c deleted file mode 100644 index 5f7c0d9241..0000000000 --- a/tests/regression/82-wrpointer/13-experiments.c +++ /dev/null @@ -1,42 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -struct Pair { - int (*first)[7]; - int second; -}; - -struct Crazy { - int whatever; - int arr[5]; -}; - -void main(void) { - int arr[7] = {1, 2, 3, 4, 5, 6, 7}; - int(*x)[7] = (int(*)[7])malloc(sizeof(int)); - struct Pair p; - p.first = x; - p.second = (*x)[3]; - - struct Pair p2; - p2.first = x; - - __goblint_check(p.first == p2.first); - - int arr2[2][2] = {{1, 2}, {1, 2}}; - p.second = arr2[1][1]; - - int *test; - - int *x2[2] = {test, test}; - - int test2 = *(x2[1]); - - struct Crazy crazyy[3][2]; - - __goblint_check(crazyy[2][1].arr[4] == ((struct Crazy *)crazyy)[5].arr[4]); - - int *sx[4]; - int k = *sx[1]; -} diff --git a/tests/regression/82-wrpointer/14-join.c b/tests/regression/82-wrpointer/14-join.c deleted file mode 100644 index 5c1e3e069a..0000000000 --- a/tests/regression/82-wrpointer/14-join.c +++ /dev/null @@ -1,23 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include - -void main(void) { - long y; - long i; - long x; - long *z; - int top; - - if (top) { - z = -1 + &x; - y = x; - } else { - z = -1 + &x; - i = x; - } - - __goblint_check(z == -1 + &x); - __goblint_check(x == i); // UNKNOWN! - __goblint_check(y == x); // UNKNOWN! -} diff --git a/tests/regression/82-wrpointer/15-arrays-structs.c b/tests/regression/82-wrpointer/15-arrays-structs.c deleted file mode 100644 index bcf0028e6f..0000000000 --- a/tests/regression/82-wrpointer/15-arrays-structs.c +++ /dev/null @@ -1,62 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -struct mystruct { - int first; - int second; -}; - -struct arrstruct { - int first[3]; - int second[3]; -}; - -void main(void) { - // array of struct - struct mystruct arrayStructs[3]; - - __goblint_check(arrayStructs[0].first == - ((int *)arrayStructs)[0]); // they are the same element - __goblint_check(arrayStructs[1].second == - ((int *)arrayStructs)[3]); // they are the same element - __goblint_check(arrayStructs[2].first == - ((int *)arrayStructs)[4]); // they are the same element - - // struct of array - struct arrstruct structArray; - int *pstruct = (int *)&structArray; // pointer to struct - __goblint_check(structArray.first[0] == - pstruct[0]); // they are the same element - __goblint_check(structArray.first[2] == - pstruct[2]); // they are the same element - __goblint_check(structArray.second[0] == - pstruct[3]); // they are the same element - __goblint_check(structArray.second[2] == - pstruct[5]); // they are the same element - - // array of array - int array2D[2][2] = {{1, 2}, {3, 4}}; - __goblint_check(array2D[0][0] == - *((int *)array2D + 0)); // they are the same element - __goblint_check(array2D[1][0] == - *((int *)array2D + 2)); // they are the same element - __goblint_check(array2D[1][1] == - *((int *)array2D + 3)); // they are the same element - - // arr2D[0][1] is the element and arr2D[2] is a pointer to an array - __goblint_check(array2D[0][1] == (long)array2D[2]); // UNKNOWN! - - __goblint_check((int *)array2D[0] + 4 == (int *)array2D[2]); - __goblint_check((int *)array2D + 4 == (int *)array2D[2]); - - __goblint_check(array2D[1][2] == *((int *)array2D + 4)); - __goblint_check((int *)array2D + 4 == (int *)array2D[2]); - - // 3D array - int array3D[2][3][4]; - __goblint_check(array3D[1][0][3] == *((int *)array3D + 15)); - __goblint_check(array3D[1][2][0] == *((int *)array3D + 20)); - __goblint_check(array3D[1][2][3] == *((int *)array3D + 23)); - __goblint_check(array3D[0][1][1] == *((int *)array3D + 5)); -} diff --git a/tests/regression/82-wrpointer/16-loops.c b/tests/regression/82-wrpointer/16-loops.c deleted file mode 100644 index f7e0a0e178..0000000000 --- a/tests/regression/82-wrpointer/16-loops.c +++ /dev/null @@ -1,28 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include -#include - -void main(void) { - long y; - long i; - long *x = malloc(sizeof(long) * 300); - long *x2 = x; - long *z; - int top; - top = top % 300; // top is some number that is < 300 - - y = *x; - z = -1 + x; - - while (top) { - z = (long *)malloc(sizeof(long)); - x++; - z = -1 + x; - y++; - top--; - } - - __goblint_check(z == -1 + x); - __goblint_check(y == *x2); // UNKNOWN! -} diff --git a/tests/regression/82-wrpointer/17-join2.c b/tests/regression/82-wrpointer/17-join2.c deleted file mode 100644 index a9300ad423..0000000000 --- a/tests/regression/82-wrpointer/17-join2.c +++ /dev/null @@ -1,21 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include - -void main(void) { - long *y = (long *)malloc(4 * sizeof(long)); - long a; - long b; - long *x = (long *)malloc(4 * sizeof(long)); - int top; - - if (top) { - *(x + 2) = a + 1; - *(y + 1) = a + 2; - } else { - *(x + 2) = b + 2; - *(y + 1) = b + 3; - } - - __goblint_check(*(x + 2) == *(y + 1) - 1); -} diff --git a/tests/regression/82-wrpointer/18-complicated-join.c b/tests/regression/82-wrpointer/18-complicated-join.c deleted file mode 100644 index f5c04c6f5a..0000000000 --- a/tests/regression/82-wrpointer/18-complicated-join.c +++ /dev/null @@ -1,25 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -// Example 1 from the paper Join Algorithms for the Theory of Uninterpreted -// Functions by Gulwani et al. - -#include -#include - -void main(void) { - long ********y = (long ********)malloc(100 * sizeof(long *)); - *y = (long *******)malloc(100 * sizeof(long *)); - **y = (long ******)malloc(100 * sizeof(long *)); - int top; - - if (top) { - **y = (long ******)y; - __goblint_check(**y == (long ******)y); - __goblint_check(******y == (long**)y); - } else { - ***y = (long ***)y; - __goblint_check(***y == (long *****)y); - __goblint_check(******y == (long**)y); - } - - __goblint_check(******y == (long**)y); -} diff --git a/tests/regression/82-wrpointer/19-disequalities.c b/tests/regression/82-wrpointer/19-disequalities.c deleted file mode 100644 index 83c2f2fa08..0000000000 --- a/tests/regression/82-wrpointer/19-disequalities.c +++ /dev/null @@ -1,40 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -void main(void) { - long *i; - long **j; - j = (int **)malloc(sizeof(int *) + 7); - *(j + 3) = (int *)malloc(sizeof(int)); - int *k; - *j = k; - - __goblint_check(**j != *k + 1); - __goblint_check(**j != *k + 2); - - if (*i != **(j + 3)) { - __goblint_check(i != *(j + 3)); - __goblint_check(&i != j + 3); - j = NULL; - __goblint_check(i != *(j + 3)); // UNKNOWN - } - - int *k2 = (int *)malloc(sizeof(int)); - *j = k2; - k = k2; - - __goblint_check(*j == k); - __goblint_check(k2 == k); - - int *f1 = (int *)malloc(sizeof(int)); - int *f2 = f2; - - if (*j != f2) { - __goblint_check(*j != f2); - __goblint_check(k != f1); - j = NULL; - __goblint_check(*j != f2); // UNKNOWN - __goblint_check(k != f1); - } -} diff --git a/tests/regression/82-wrpointer/20-self-pointing-struct.c b/tests/regression/82-wrpointer/20-self-pointing-struct.c deleted file mode 100644 index 4221cab013..0000000000 --- a/tests/regression/82-wrpointer/20-self-pointing-struct.c +++ /dev/null @@ -1,21 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -#include -#include - -struct list { - int data; - struct list *next; -}; - -void main(void) { - struct list last = { - 41 - }; - struct list first = { - 42, &last - }; - - last.next = &last; - - __goblint_check(first.next->next->next->next == &last); -} diff --git a/tests/regression/82-wrpointer/21-global-var.c b/tests/regression/82-wrpointer/21-global-var.c deleted file mode 100644 index f8587f3484..0000000000 --- a/tests/regression/82-wrpointer/21-global-var.c +++ /dev/null @@ -1,40 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include -#include - -int **i; -int **j; -int counter; - -void f() { __goblint_check(*i == *j); } - -void recursive_f() { - __goblint_check(*i == *j); - counter++; - if (counter < 25) - recursive_f(); -} - -void non_terminating_f() { - if (*i == *j) - non_terminating_f(); -} - -int main(void) { - - j = (int **)malloc(sizeof(int *)); - i = (int **)malloc(sizeof(int *)); - *i = (int *)malloc(sizeof(int)); - - *j = *i; - f(); - - recursive_f(); - - non_terminating_f(); - - __goblint_check(0); // NOWARN (unreachable) - - return 0; -} diff --git a/tests/regression/82-wrpointer/22-join-diseq.c b/tests/regression/82-wrpointer/22-join-diseq.c deleted file mode 100644 index 97c273b65b..0000000000 --- a/tests/regression/82-wrpointer/22-join-diseq.c +++ /dev/null @@ -1,37 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include - -void main(void) { - long *a; - long *b; - long *c; - long *d = (long *)malloc(4 * sizeof(long)); - long *e = (long *)malloc(4 * sizeof(long)); - - long *unknown; - - int top; - - if (a != b + 4 && e != c && c != d) { - __goblint_check(a != b + 4); - __goblint_check(e != c); - __goblint_check(c != d); - if (top) { - d = unknown; - __goblint_check(a != b + 4); - __goblint_check(e != c); - __goblint_check(c != d); // UNKNOWN! - - } else { - e = unknown; - __goblint_check(a != b + 4); - __goblint_check(e != c); // UNKNOWN! - __goblint_check(c != d); - } - // JOIN - __goblint_check(a != b + 4); - __goblint_check(e != c); // UNKNOWN! - __goblint_check(c != d); // UNKNOWN! - } -} diff --git a/tests/regression/82-wrpointer/23-function-deref.c b/tests/regression/82-wrpointer/23-function-deref.c deleted file mode 100644 index 1052cec9c5..0000000000 --- a/tests/regression/82-wrpointer/23-function-deref.c +++ /dev/null @@ -1,25 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include -#include - -void *g(int **a, int *b) { - b = (int *)malloc(sizeof(int *)); - *a = b; -} - -int main(void) { - int *i = (int *)malloc(sizeof(int)); - int **j; - j = (int **)malloc(sizeof(int *)); - *j = (int *)malloc(sizeof(int)); - int *k = *j; - - __goblint_check(k == *j); - - g(j, i); - - __goblint_check(k == *j); // UNKNOWN! - - return 0; -} diff --git a/tests/regression/82-wrpointer/24-disequalities-small-example.c b/tests/regression/82-wrpointer/24-disequalities-small-example.c deleted file mode 100644 index bad8fc0cb4..0000000000 --- a/tests/regression/82-wrpointer/24-disequalities-small-example.c +++ /dev/null @@ -1,12 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -int *a, b; -c() { b = 0; } -main() { - int *d; - if (a == d) - ; - else - __goblint_check(a != d); - c(); -} diff --git a/tests/regression/82-wrpointer/25-struct-circular.c b/tests/regression/82-wrpointer/25-struct-circular.c deleted file mode 100644 index ff1bed0a77..0000000000 --- a/tests/regression/82-wrpointer/25-struct-circular.c +++ /dev/null @@ -1,28 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include - -struct mem { - int val; -}; - -struct list_node { - int x; - struct mem *mem; - struct list_node *next; -}; - -int main() { - struct mem *m = malloc(sizeof(*m)); - int x = ((struct mem *) m)->val; - m->val = 100; - - struct list_node *head = malloc(sizeof(*head)); - - head->x = 1; - head->mem = m; - head->next = head; - - __goblint_check(head->next == head); - __goblint_check(head->next->next == head->next); -} diff --git a/tests/regression/82-wrpointer/26-join3.c b/tests/regression/82-wrpointer/26-join3.c deleted file mode 100644 index 7b4531d7f3..0000000000 --- a/tests/regression/82-wrpointer/26-join3.c +++ /dev/null @@ -1,45 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include -#include -#include - -void main(void) { - long *x; - long *y; - long *z = malloc(sizeof(long)); - int top; - - if (top) { - x = z + 7; - y = z + 3; - } else { - x = z + 1; - y = z + 1; - } - - __goblint_check(x == z + 7); // UNKNOWN! - __goblint_check(x == z + 3); // UNKNOWN! - __goblint_check(x == z + 1); // UNKNOWN! - __goblint_check(x == z + 1); // UNKNOWN! - - long *x1; - long *x2; - long *y1; - long *y2; - - if (top) { - x1 = z + 1; - y1 = z + 2; - x2 = z + 1; - y2 = z + 2; - } else { - x1 = z + 2; - y1 = z + 3; - x2 = z + 4; - y2 = z + 5; - } - - __goblint_check(x1 == y1 - 1); - __goblint_check(x2 == y2 - 1); -} diff --git a/tests/regression/82-wrpointer/27-join-diseq2.c b/tests/regression/82-wrpointer/27-join-diseq2.c deleted file mode 100644 index 2ece6062d6..0000000000 --- a/tests/regression/82-wrpointer/27-join-diseq2.c +++ /dev/null @@ -1,39 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -#include -#include - -int main(void) { - long *a; - long *b; - long *c; - long *d = (long *)malloc(4 * sizeof(long)); - long *e = (long *)malloc(4 * sizeof(long)); - - long *unknown; - - int top; - - if (a != b && e != c && c != d) { - __goblint_check(a != b); - __goblint_check(e != c); - __goblint_check(c != d); - if (top) { - d = unknown; - d = c + 1; - __goblint_check(a != b); - __goblint_check(e != c); - __goblint_check(c != d); // implicit disequality - } else { - e = unknown; - __goblint_check(a != b); - __goblint_check(e != c); // UNKNOWN! - __goblint_check(c != d); - } - // JOIN - __goblint_check(a != b); - __goblint_check(e != c); // UNKNOWN! - __goblint_check(c != d); - } - return 0; -} diff --git a/tests/regression/82-wrpointer/28-return-value.c b/tests/regression/82-wrpointer/28-return-value.c deleted file mode 100644 index 10087d3485..0000000000 --- a/tests/regression/82-wrpointer/28-return-value.c +++ /dev/null @@ -1,16 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -int a, b, c; -void *d(const *e) { return e + 200; } -int *f() {} -main() { - g(a, c, b); - if (0) { - __goblint_check(0); // NOWARN (unreachable) - } - __goblint_check(1); // reachable -} -g(int, struct h *, struct i *) { - int *j = f(); - d(j); - __goblint_check(1); // reachable -} diff --git a/tests/regression/82-wrpointer/29-widen.c b/tests/regression/82-wrpointer/29-widen.c deleted file mode 100644 index d91e9fbacc..0000000000 --- a/tests/regression/82-wrpointer/29-widen.c +++ /dev/null @@ -1,25 +0,0 @@ -// PARAM: --set ana.activated[+] wrpointer --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts - -int a; -long b, c, d, e, f, g, h; -int *i; -k() { - int j; - long top; - while (top) { - b = a * 424; - c = j; - d = j + b; - e = a * 424; - f = e + 8; - g = j; - h = j + f; - i = h; - a = a + 1; - __goblint_check(g == c); - // __goblint_check(h == 8 + d); - __goblint_check((long)i == h); - __goblint_check(j == c); - } -} -main() { k(); } diff --git a/tests/regression/83-c2po/18-complicated-join.c b/tests/regression/83-c2po/18-complicated-join.c index a5f370dedc..935107b258 100644 --- a/tests/regression/83-c2po/18-complicated-join.c +++ b/tests/regression/83-c2po/18-complicated-join.c @@ -1,5 +1,7 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.askbase false -// Example 1 from the paper Join Algorithms for the Theory of Uninterpreted Functions by Gulwani et al. +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts +// TODO add configuration to use the join with automata +// Example 1 from the paper Join Algorithms for the Theory of Uninterpreted +// Functions by Gulwani et al. #include #include @@ -13,12 +15,12 @@ void main(void) { if (top) { **y = (long ******)y; __goblint_check(**y == (long ******)y); - __goblint_check(******y == (long **)y); + __goblint_check(******y == (long**)y); } else { ***y = (long ***)y; __goblint_check(***y == (long *****)y); - __goblint_check(******y == (long **)y); + __goblint_check(******y == (long**)y); } - // This does not work any more because the analysis is not precise enough - __goblint_check(******y == (long **)y); // UNKNOWN + + __goblint_check(******y == (long**)y); } From eb09f119450e22f984184c09b8a8345fdce6f9ca Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 11:18:16 +0200 Subject: [PATCH 231/323] add configurations for choosing which join and which equal algorithm should be used --- src/cdomains/c2poDomain.ml | 10 ++++------ src/config/options.schema.json | 12 ++++++++++++ 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index bd2f4202c4..a6a04f70d5 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -2,7 +2,6 @@ open Batteries open GoblintCil -module Var = CilType.Varinfo open CongruenceClosure open CongruenceClosure module M = Messages @@ -28,7 +27,6 @@ module D = struct let name () = "c2po" - let equal_standard x y = if x == y then true @@ -50,7 +48,6 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res - let equal_min_repr x y = if x == y then true @@ -62,7 +59,7 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res - let equal = if (*TODO*) true then equal_standard else equal_min_repr + let equal = if GobConfig.get_bool "ana.c2po.normal_form" then equal_min_repr else equal_standard let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} @@ -117,7 +114,7 @@ module D = struct (show_all res); res - let join = if (*TODO*) true then join_eq_classes else join_automaton + let join = if GobConfig.get_bool "ana.c2po.precise_join" then join_automaton else join_eq_classes let widen_eq_classes a b = if a == b then @@ -139,7 +136,8 @@ module D = struct (show_all res); res - let widen = if M.tracing then M.trace "c2po-join" "WIDEN\n";if (*TODO*) true then join else widen_eq_classes + let widen = if M.tracing then M.trace "c2po-join" "WIDEN\n"; + if GobConfig.get_bool "ana.c2po.precise_join" then join (*TODO*) else widen_eq_classes let meet a b = if a == b then diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 4de5da3e9b..8afd8ca403 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -1139,6 +1139,18 @@ "description": "If true, the C-2PO Analysis uses the MayPointTo query to infer additional disequalities.", "type": "boolean", "default": true + }, + "precise_join": { + "title": "ana.c2po.precise_join", + "description": "If true, the C-2PO Analysis uses a more precise version of the join algorithm, by using the automaton to compute the join.", + "type": "boolean", + "default": false + }, + "normal_form": { + "title": "ana.c2po.normal_form", + "description": "If true, the C-2PO Analysis computes a normal form of the domain, using minimal representatives of the equivalence classes, in order to check for equailty between two domain elements. If false, it compares the equivalence classes of the two domain elements.", + "type": "boolean", + "default": false } }, "additionalProperties": false From da0ea4a1f0d5fdb5a954efbb22ab29ce5724e04a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 13:09:07 +0200 Subject: [PATCH 232/323] update tracing --- src/cdomains/c2poDomain.ml | 9 +++++---- src/cdomains/congruenceClosure.ml | 2 +- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index a6a04f70d5..ff91bb964f 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -80,7 +80,7 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> - if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); let cc = fst(join_eq a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf @@ -103,7 +103,7 @@ module D = struct if a == b then a' else - (if M.tracing then M.tracel "c2po-join" "JOIN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (if M.tracing then M.tracel "c2po-join" "JOIN EQ CLASSES. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); let cc = fst(join_eq_no_automata a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf @@ -114,7 +114,8 @@ module D = struct (show_all res); res - let join = if GobConfig.get_bool "ana.c2po.precise_join" then join_automaton else join_eq_classes + let join = if GobConfig.get_bool "ana.c2po.precise_join" then + (if M.tracing then M.trace "c2po-join" "Join Automaton"; join_automaton) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_eq_classes) let widen_eq_classes a b = if a == b then @@ -132,7 +133,7 @@ module D = struct in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) in - if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" + if M.tracing then M.tracel "c2po-join" "WIDEN. WIDEN: %s\n" (show_all res); res diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 01dda5e173..1ff0a09478 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -991,7 +991,7 @@ module CongruenceClosure = struct (* Remove variables: *) let remove_terms_from_eq predicate cc = - let rec insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in + let insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in (* start from all initial states that are still valid and find new representatives if necessary *) (* new_reps maps each representative term to the new representative of the equivalence class *) (*but new_reps contains an element but not necessarily the representative!!*) From dc2a4beffd1d8a2dc89ac922cd2d8b5d03d6c209 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 16:55:35 +0200 Subject: [PATCH 233/323] fix the join and widen etc. It was because I didn't explicitly write the parameters of the function,... --- src/cdomains/c2poDomain.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index ff91bb964f..e14844099d 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -59,7 +59,7 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res - let equal = if GobConfig.get_bool "ana.c2po.normal_form" then equal_min_repr else equal_standard + let equal a b = if GobConfig.get_bool "ana.c2po.normal_form" then equal_min_repr a b else equal_standard a b let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} @@ -114,8 +114,8 @@ module D = struct (show_all res); res - let join = if GobConfig.get_bool "ana.c2po.precise_join" then - (if M.tracing then M.trace "c2po-join" "Join Automaton"; join_automaton) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_eq_classes) + let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then + (if M.tracing then M.trace "c2po-join" "Join Automaton"; join_automaton a b) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_eq_classes a b) let widen_eq_classes a b = if a == b then @@ -137,8 +137,8 @@ module D = struct (show_all res); res - let widen = if M.tracing then M.trace "c2po-join" "WIDEN\n"; - if GobConfig.get_bool "ana.c2po.precise_join" then join (*TODO*) else widen_eq_classes + let widen a b = if M.tracing then M.trace "c2po-join" "WIDEN\n"; + if GobConfig.get_bool "ana.c2po.precise_join" then join a b(*TODO*) else widen_eq_classes a b let meet a b = if a == b then From 40678f6e50c1a2d05c214b99b24c3dc3d7f5b38d Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 8 Jul 2024 16:56:24 +0200 Subject: [PATCH 234/323] use --enable instead of --set --- tests/regression/83-c2po/18-complicated-join.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/regression/83-c2po/18-complicated-join.c b/tests/regression/83-c2po/18-complicated-join.c index 935107b258..12c6d94715 100644 --- a/tests/regression/83-c2po/18-complicated-join.c +++ b/tests/regression/83-c2po/18-complicated-join.c @@ -1,5 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts -// TODO add configuration to use the join with automata +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --enable ana.c2po.precise_join // Example 1 from the paper Join Algorithms for the Theory of Uninterpreted // Functions by Gulwani et al. From c6655481b3f51dc16e177a4cc422a4ca5e4cf8ff Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Jul 2024 11:22:59 +0200 Subject: [PATCH 235/323] fix unsound behaviour --- src/analyses/c2poAnalysis.ml | 3 +-- src/cdomains/c2poDomain.ml | 14 +++++++++----- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index ddaa3663e2..f724cde972 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -136,8 +136,7 @@ struct match T.get_element_size_in_bits lval_t, T.of_lval ask lval with (* Indefinite assignment *) | s, lterm -> - (* let t = D.remove_may_equal_terms ask s lterm t in - -> not necessary because lterm is always a new fresh variable in goblint *) + let t = D.remove_may_equal_terms ask s lterm t in add_block_diseqs t lterm (* Definite assignment *) | exception (T.UnsupportedCilExpression _) -> D.top () diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 4eac7dbc94..535a56b63a 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1094,10 +1094,13 @@ module MayBeEqual = struct | res -> res let may_point_to_all_equal_terms ask exp cc term offset = - let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in + let equal_terms = if TMap.mem term cc.uf then + let comp = Disequalities.comp_t cc.uf term in + let valid_term (t,z) = + T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + List.filter valid_term comp + else [(term,Z.zero)] + in if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" d_exp exp (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); let intersect_query_result res (term,z) = @@ -1165,7 +1168,8 @@ module MayBeEqual = struct | Deref (v, z',_) -> (may_point_to_address ask adresses v z' cc) || (may_point_to_one_of_these_adresses ask adresses cc v) - | Addr _ | Aux _ -> false + | Addr _ -> false + | Aux (v,e) -> may_point_to_address ask adresses (Addr v) Z.zero cc end From 2840b4c8be9149938fd61c5825d1ca8d95714e4f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Jul 2024 12:27:04 +0200 Subject: [PATCH 236/323] fix arithmeticonintegerbot and invalid_widen --- src/cdomains/c2poDomain.ml | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 535a56b63a..522740b4d9 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1046,7 +1046,7 @@ module CongruenceClosure = struct | Nequal (t1,t2,z) -> let (min_state1, min_z1) = TUF.find_no_pc cc2.uf t1 in let (min_state2, min_z2) = TUF.find_no_pc cc2.uf t2 in - let new_offset = Z.(-min_z2 + min_z1 + z) in + let new_offset = Z.(min_z2 - min_z1 + z) in normalize_diseqs (min_state1, min_state2, new_offset) | _ -> dis in let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ @@ -1107,9 +1107,12 @@ module MayBeEqual = struct let next_query = match ask_may_point_to ask (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with | exception (T.UnsupportedCilExpression _) -> AD.top() - | res -> if AD.is_bot res then AD.top() else res + | result -> if AD.is_bot result then AD.top() else result in - AD.meet res next_query in + match AD.meet res next_query with + | exception (IntDomain.ArithmeticOnIntegerBot _) -> res + | result -> result + in List.fold intersect_query_result (AD.top()) equal_terms (**Find out if two addresses are possibly equal by using the MayPointTo query. *) @@ -1119,9 +1122,11 @@ module MayBeEqual = struct | exp2 -> let mpt1 = adresses in let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in - let res = not (AD.is_bot (AD.meet mpt1 mpt2)) in + let res = try not (AD.is_bot (AD.meet mpt1 mpt2)) + with IntDomain.ArithmeticOnIntegerBot _ -> true + in if M.tracing then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" - AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (AD.meet mpt1 mpt2) (string_of_bool res); res + AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (try AD.meet mpt1 mpt2 with IntDomain.ArithmeticOnIntegerBot _ -> AD.bot ()) (string_of_bool res); res let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = if T.equal t1 t2 then true else From ba0c28e63644cc9c460bc3aec8789c7337220814 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Jul 2024 12:29:51 +0200 Subject: [PATCH 237/323] change tracing a bit --- src/analyses/c2poAnalysis.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index f724cde972..8f2d1dd3d0 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -103,15 +103,15 @@ struct let assign ctx lval expr = let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in - if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "" res); res + if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "None" res); res let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in let res = meet_conjs_opt valid_props ctx.local in + if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s; is_bot: %b\n" + d_exp e pos (show_conj valid_props) (D.is_bot res); if D.is_bot res then raise Deadcode; - if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s\n" - d_exp e pos (show_conj valid_props); res let body ctx f = ctx.local (*DONE*) From cb6bc2acf6fdb1171427881290deac8c5a9d4962 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Jul 2024 15:33:59 +0200 Subject: [PATCH 238/323] fix block disequality query --- src/cdomains/c2poDomain.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 522740b4d9..02a2d09c8b 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -778,7 +778,7 @@ module CongruenceClosure = struct let (v2,r2),cc = insert cc t2 in match cc with | None -> true - | Some cc -> BlDis.map_set_mem t1 t2 cc.bldis + | Some cc -> BlDis.map_set_mem v1 v2 cc.bldis (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = @@ -794,7 +794,7 @@ module CongruenceClosure = struct match cc with | None -> true | Some cc -> (* implicit disequalities following from block disequalities *) - BlDis.map_set_mem t1 t2 cc.bldis || + BlDis.map_set_mem v1 v2 cc.bldis || (*explicit dsequalities*) Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq From 0df379ece9bc47b9a06b99283f6139a2792c8c70 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Jul 2024 16:24:26 +0200 Subject: [PATCH 239/323] implemented Invariant --- src/analyses/c2poAnalysis.ml | 9 +++++++-- src/cdomains/c2poDomain.ml | 7 +++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 8f2d1dd3d0..452c78963e 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -75,8 +75,13 @@ struct let ik = Cilfacade.get_ikind_exp e in ID.of_bool ik res end - (* TODO Invariant. - | Queries.Invariant context -> get_normal_form context*) + | Queries.Invariant context -> + let scope = Node.find_fundec ctx.node in + begin match D.remove_vars_not_in_scope scope ctx.local with + | None -> Invariant.top() + | Some t -> + T.conj_to_invariant (get_normal_form t) + end (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) | _ -> Result.top q diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 02a2d09c8b..4de8d86115 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1341,4 +1341,11 @@ module D = struct if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) + (** Remove terms from the data structure. + It removes all terms that are not in the scope, and also those that are tmp variables.*) + let remove_vars_not_in_scope scope cc = + Option.bind cc (fun cc -> remove_terms (fun t -> + let var = T.get_var t in + InvariantCil.var_is_tmp var || not (InvariantCil.var_is_in_scope scope var)) cc) + end From ada5779a8bb141331376fc68aaa7889ce3b2d0ad Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Jul 2024 16:30:00 +0200 Subject: [PATCH 240/323] implemented Invariant --- src/cdomains/unionFind.ml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index efd63a4a5e..c765559891 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -472,6 +472,20 @@ module T = struct end | UnOp (LNot, e1, _) -> prop_of_cil ask e1 (not pos) | _ -> [] + + let prop_to_cil p = + let op,t1,t2,z = match p with + | Equal (t1,t2,z) -> Eq, t1, t2, z + | Nequal (t1,t2,z) -> Ne, t1, t2, z + | BlNequal (t1,t2) -> Ne, t1, t2, Z.zero + in + BinOp (op, to_cil t1, to_cil_sum z (to_cil t2), TInt (IBool,[])) + + let conj_to_invariant conjs = + List.fold (fun a prop -> let exp = prop_to_cil prop in + if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; + Invariant.(a && of_exp exp)) (Invariant.top()) conjs + end module TMap = struct From 700017f8d25bca1601998d35f7603ae35599847c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 9 Jul 2024 16:49:18 +0200 Subject: [PATCH 241/323] remove unused rec flag --- src/cdomains/c2poDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 4de8d86115..098cfa7eaf 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -834,7 +834,7 @@ module CongruenceClosure = struct (* Remove variables: *) let remove_terms_from_eq predicate cc = - let rec insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in + let insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in (* start from all initial states that are still valid and find new representatives if necessary *) (* new_reps maps each representative term to the new representative of the equivalence class *) (*but new_reps contains an element but not necessarily the representative!!*) From 8173b99f25903d3ea68d7a22a042ec3bbb5a7c94 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 9 Jul 2024 18:09:06 +0200 Subject: [PATCH 242/323] Horrible, horrible fix. May the gods forgive us! --- src/util/library/libraryDsl.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/util/library/libraryDsl.ml b/src/util/library/libraryDsl.ml index 64684fb1ce..e4ce75ba8d 100644 --- a/src/util/library/libraryDsl.ml +++ b/src/util/library/libraryDsl.ml @@ -61,16 +61,16 @@ let rec accs: type k r. (k, r) args_desc -> Accesses.t = fun args_desc args -> | Some args -> (acc, arg :: args) :: List.remove_assoc acc accs'' | None -> (acc, [arg]) :: accs'' ) accs'' arg_desc.accesses - | _, _ -> invalid_arg "accs" + | _, _ -> [] let special ?(attrs:attr list=[]) args_desc special_cont = { - special = Fun.flip (match_args args_desc) special_cont; + special = (fun args -> try Fun.flip (match_args args_desc) special_cont args with _ -> Unknown); accs = accs args_desc; attrs; } let special' ?(attrs:attr list=[]) args_desc special_cont = { - special = (fun args -> Fun.flip (match_args args_desc) (special_cont ()) args); (* eta-expanded such that special_cont is re-executed on each call instead of once during LibraryFunctions construction *) + special = (fun args -> try Fun.flip (match_args args_desc) (special_cont ()) args with _ -> Unknown); (* eta-expanded such that special_cont is re-executed on each call instead of once during LibraryFunctions construction *) accs = accs args_desc; attrs; } From af4e693fae54c0dcf57d8ea730aac8b7022aadc5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 10 Jul 2024 11:20:29 +0200 Subject: [PATCH 243/323] add conf file for the tests with witnesses --- conf/witness-c2po.json | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 conf/witness-c2po.json diff --git a/conf/witness-c2po.json b/conf/witness-c2po.json new file mode 100644 index 0000000000..f5040bb585 --- /dev/null +++ b/conf/witness-c2po.json @@ -0,0 +1,28 @@ +{ + "ana": { + "activated": [ + "expRelation", + "base", + "threadid", + "threadflag", + "threadreturn", + "escape", + "mutexEvents", + "mutex", + "access", + "race", + "mallocWrapper", + "mhp", + "assert", + "pthreadMutexType", + "c2po", + "startState", + "taintPartialContexts" + ] + }, + "witness": { + "yaml": { + "enabled": true + } + } +} From 5169a9718b4faa04c677bf1dd63b642812403d76 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 10 Jul 2024 11:26:01 +0200 Subject: [PATCH 244/323] changed my mind --- conf/witness-c2po.json | 28 ---------------------------- 1 file changed, 28 deletions(-) delete mode 100644 conf/witness-c2po.json diff --git a/conf/witness-c2po.json b/conf/witness-c2po.json deleted file mode 100644 index f5040bb585..0000000000 --- a/conf/witness-c2po.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "ana": { - "activated": [ - "expRelation", - "base", - "threadid", - "threadflag", - "threadreturn", - "escape", - "mutexEvents", - "mutex", - "access", - "race", - "mallocWrapper", - "mhp", - "assert", - "pthreadMutexType", - "c2po", - "startState", - "taintPartialContexts" - ] - }, - "witness": { - "yaml": { - "enabled": true - } - } -} From 887ab9816003d98a9787a641497ab5db81956907 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 10 Jul 2024 16:34:23 +0200 Subject: [PATCH 245/323] now I'm the only one that answers the invariant query --- src/analyses/apron/relationAnalysis.apron.ml | 3 +- src/analyses/base.ml | 669 ++++++++++--------- src/analyses/c2poAnalysis.ml | 2 +- src/analyses/varEq.ml | 4 +- src/witness/witnessConstraints.ml | 6 +- witness_tests.sh | 14 + 6 files changed, 357 insertions(+), 341 deletions(-) create mode 100755 witness_tests.sh diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index ad99e26b58..aafa581a72 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -654,7 +654,8 @@ struct | Queries.IterSysVars (vq, vf) -> let vf' x = vf (Obj.repr x) in Priv.iter_sys_vars ctx.global vq vf' - | Queries.Invariant context -> query_invariant ctx context + | Queries.Invariant context -> Invariant.top() + (* query_invariant ctx context *) | _ -> Result.top q diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 29fa74c5a9..c9c1724c6e 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1543,7 +1543,8 @@ struct | Q.IterSysVars (vq, vf) -> let vf' x = vf (Obj.repr (V.priv x)) in Priv.iter_sys_vars (priv_getg ctx.global) vq vf' - | Q.Invariant context -> query_invariant ctx context + | Q.Invariant context -> Invariant.top() + (* query_invariant ctx context *) | Q.InvariantGlobal g -> let g: V.t = Obj.obj g in query_invariant_global ctx g @@ -2444,352 +2445,352 @@ struct end in let st = match desc.special args, f.vname with - | Memset { dest; ch; count; }, _ -> - (* TODO: check count *) - let eval_ch = eval_rv ~ctx st ch in - let dest_a, dest_typ = addr_type_of_exp dest in - let value = - match eval_ch with - | Int i when ID.to_int i = Some Z.zero -> - VD.zero_init_value dest_typ - | _ -> - VD.top_value dest_typ - in - set ~ctx st dest_a dest_typ value - | Bzero { dest; count; }, _ -> - (* TODO: share something with memset special case? *) - (* TODO: check count *) - let dest_a, dest_typ = addr_type_of_exp dest in - let value = VD.zero_init_value dest_typ in - set ~ctx st dest_a dest_typ value - | Memcpy { dest = dst; src; n; }, _ -> (* TODO: use n *) - memory_copying dst src (Some n) - | Strcpy { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_copy ar1 ar2 (eval_n n))) - | Strcat { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_concat ar1 ar2 (eval_n n))) - | Strlen s, _ -> - begin match lv with - | Some lv_val -> - let dest_a = eval_lv ~ctx st lv_val in - let dest_typ = Cilfacade.typeOfLval lv_val in - let v = eval_rv ~ctx st s in - let a = address_from_value v in - let value:value = - (* if s string literal, compute strlen in string literals domain *) - (* TODO: is this reliable? there could be a char* which isn't StrPtr *) - if CilType.Typ.equal (AD.type_of a) charPtrType then - Int (AD.to_string_length a) - (* else compute strlen in array domain *) - else - begin match get ~ctx st a None with - | Array array_s -> Int (CArrays.to_string_length array_s) - | _ -> VD.top_value (unrollType dest_typ) - end in - set ~ctx st dest_a dest_typ value - | None -> st - end - | Strstr { haystack; needle }, _ -> - begin match lv with - | Some lv_val -> - (* check if needle is a substring of haystack in string literals domain if haystack and needle are string literals, - else check in null bytes domain if both haystack and needle are / can be transformed to an array domain representation; - if needle is substring, assign the substring of haystack starting at the first occurrence of needle to dest, - if it surely isn't, assign a null_ptr *) - string_manipulation haystack needle lv true (Some (fun h_a n_a -> Address (AD.substring_extraction h_a n_a))) - (fun h_ar n_ar -> match CArrays.substring_extraction h_ar n_ar with - | CArrays.IsNotSubstr -> Address (AD.null_ptr) - | CArrays.IsSubstrAtIndex0 -> Address (eval_lv ~ctx st (mkMem ~addr:(Cil.stripCasts haystack) ~off:NoOffset)) - | CArrays.IsMaybeSubstr -> Address (AD.join (eval_lv ~ctx st - (mkMem ~addr:(Cil.stripCasts haystack) ~off:(Index (Lazy.force Offset.Index.Exp.any, NoOffset)))) (AD.null_ptr))) - | None -> st - end - | Strcmp { s1; s2; n }, _ -> - begin match lv with - | Some _ -> - (* when s1 and s2 are string literals, compare both completely or their first n characters in the string literals domain; - else compare them in the null bytes array domain if they are / can be transformed to an array domain representation *) - string_manipulation s1 s2 lv false (Some (fun s1_a s2_a -> Int (AD.string_comparison s1_a s2_a (eval_n n)))) - (fun s1_ar s2_ar -> Int (CArrays.string_comparison s1_ar s2_ar (eval_n n))) - | None -> st - end - | Abort, _ -> raise Deadcode - | ThreadExit { ret_val = exp }, _ -> - begin match ThreadId.get_current (Analyses.ask_of_ctx ctx) with - | `Lifted tid -> - ( - let rv = eval_rv ~ctx ctx.local exp in - ctx.sideg (V.thread tid) (G.create_thread rv); - (* TODO: emit thread return event so other analyses are aware? *) - (* TODO: publish still needed? *) - publish_all ctx `Return; (* like normal return *) - let ask = Analyses.ask_of_ctx ctx in - match ThreadId.get_current ask with - | `Lifted tid when ThreadReturn.is_current ask -> - ignore @@ Priv.thread_return ask (priv_getg ctx.global) (priv_sideg ctx.sideg) tid st - | _ -> ()) - | _ -> () - end; - raise Deadcode - | MutexAttrSetType {attr = attr; typ = mtyp}, _ -> - begin - let get_type lval = - let address = eval_lv ~ctx st lval in - AD.type_of address + | Memset { dest; ch; count; }, _ -> + (* TODO: check count *) + let eval_ch = eval_rv ~ctx st ch in + let dest_a, dest_typ = addr_type_of_exp dest in + let value = + match eval_ch with + | Int i when ID.to_int i = Some Z.zero -> + VD.zero_init_value dest_typ + | _ -> + VD.top_value dest_typ in - let dst_lval = mkMem ~addr:(Cil.stripCasts attr) ~off:NoOffset in - let dest_typ = get_type dst_lval in - let dest_a = eval_lv ~ctx st dst_lval in - match eval_rv ~ctx st mtyp with - | Int x -> - begin - match ID.to_int x with - | Some z -> - if M.tracing then M.tracel "attr" "setting"; - set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.of_int z)) - | None -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) - end - | _ -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) - end - | Identity e, _ -> - begin match lv with - | Some x -> assign ctx x e - | None -> ctx.local - end - (**Floating point classification and trigonometric functions defined in c99*) - | Math { fun_args; }, _ -> - let apply_unary fk float_fun x = - let eval_x = eval_rv ~ctx st x in - begin match eval_x with - | Float float_x -> float_fun (FD.cast_to fk float_x) - | _ -> failwith ("non-floating-point argument in call to function "^f.vname) + set ~ctx st dest_a dest_typ value + | Bzero { dest; count; }, _ -> + (* TODO: share something with memset special case? *) + (* TODO: check count *) + let dest_a, dest_typ = addr_type_of_exp dest in + let value = VD.zero_init_value dest_typ in + set ~ctx st dest_a dest_typ value + | Memcpy { dest = dst; src; n; }, _ -> (* TODO: use n *) + memory_copying dst src (Some n) + | Strcpy { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_copy ar1 ar2 (eval_n n))) + | Strcat { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_concat ar1 ar2 (eval_n n))) + | Strlen s, _ -> + begin match lv with + | Some lv_val -> + let dest_a = eval_lv ~ctx st lv_val in + let dest_typ = Cilfacade.typeOfLval lv_val in + let v = eval_rv ~ctx st s in + let a = address_from_value v in + let value:value = + (* if s string literal, compute strlen in string literals domain *) + (* TODO: is this reliable? there could be a char* which isn't StrPtr *) + if CilType.Typ.equal (AD.type_of a) charPtrType then + Int (AD.to_string_length a) + (* else compute strlen in array domain *) + else + begin match get ~ctx st a None with + | Array array_s -> Int (CArrays.to_string_length array_s) + | _ -> VD.top_value (unrollType dest_typ) + end in + set ~ctx st dest_a dest_typ value + | None -> st end - in - let apply_binary fk float_fun x y = - let eval_x = eval_rv ~ctx st x in - let eval_y = eval_rv ~ctx st y in - begin match eval_x, eval_y with - | Float float_x, Float float_y -> float_fun (FD.cast_to fk float_x) (FD.cast_to fk float_y) - | _ -> failwith ("non-floating-point argument in call to function "^f.vname) + | Strstr { haystack; needle }, _ -> + begin match lv with + | Some lv_val -> + (* check if needle is a substring of haystack in string literals domain if haystack and needle are string literals, + else check in null bytes domain if both haystack and needle are / can be transformed to an array domain representation; + if needle is substring, assign the substring of haystack starting at the first occurrence of needle to dest, + if it surely isn't, assign a null_ptr *) + string_manipulation haystack needle lv true (Some (fun h_a n_a -> Address (AD.substring_extraction h_a n_a))) + (fun h_ar n_ar -> match CArrays.substring_extraction h_ar n_ar with + | CArrays.IsNotSubstr -> Address (AD.null_ptr) + | CArrays.IsSubstrAtIndex0 -> Address (eval_lv ~ctx st (mkMem ~addr:(Cil.stripCasts haystack) ~off:NoOffset)) + | CArrays.IsMaybeSubstr -> Address (AD.join (eval_lv ~ctx st + (mkMem ~addr:(Cil.stripCasts haystack) ~off:(Index (Lazy.force Offset.Index.Exp.any, NoOffset)))) (AD.null_ptr))) + | None -> st end - in - let apply_abs ik x = - let eval_x = eval_rv ~ctx st x in - begin match eval_x with - | Int int_x -> - let xcast = ID.cast_to ik int_x in - (* the absolute value of the most-negative value is out of range for 2'complement types *) - (match (ID.minimal xcast), (ID.minimal (ID.top_of ik)) with - | _, None - | None, _ -> ID.top_of ik - | Some mx, Some mm when Z.equal mx mm -> ID.top_of ik - | _, _ -> - let x1 = ID.neg (ID.meet (ID.ending ik Z.zero) xcast) in - let x2 = ID.meet (ID.starting ik Z.zero) xcast in - ID.join x1 x2 - ) - | _ -> failwith ("non-integer argument in call to function "^f.vname) + | Strcmp { s1; s2; n }, _ -> + begin match lv with + | Some _ -> + (* when s1 and s2 are string literals, compare both completely or their first n characters in the string literals domain; + else compare them in the null bytes array domain if they are / can be transformed to an array domain representation *) + string_manipulation s1 s2 lv false (Some (fun s1_a s2_a -> Int (AD.string_comparison s1_a s2_a (eval_n n)))) + (fun s1_ar s2_ar -> Int (CArrays.string_comparison s1_ar s2_ar (eval_n n))) + | None -> st end - in - let result:value = - begin match fun_args with - | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> Float (FD.nan_of fk) - | Nan _ -> failwith ("non-pointer argument in call to function "^f.vname) - | Inf fk -> Float (FD.inf_of fk) - | Isfinite x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isfinite x)) - | Isinf x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isinf x)) - | Isnan x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnan x)) - | Isnormal x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnormal x)) - | Signbit x -> Int (ID.cast_to IInt (apply_unary FDouble FD.signbit x)) - | Ceil (fk,x) -> Float (apply_unary fk FD.ceil x) - | Floor (fk,x) -> Float (apply_unary fk FD.floor x) - | Fabs (fk, x) -> Float (apply_unary fk FD.fabs x) - | Acos (fk, x) -> Float (apply_unary fk FD.acos x) - | Asin (fk, x) -> Float (apply_unary fk FD.asin x) - | Atan (fk, x) -> Float (apply_unary fk FD.atan x) - | Atan2 (fk, y, x) -> Float (apply_binary fk (fun y' x' -> FD.atan (FD.div y' x')) y x) - | Cos (fk, x) -> Float (apply_unary fk FD.cos x) - | Sin (fk, x) -> Float (apply_unary fk FD.sin x) - | Tan (fk, x) -> Float (apply_unary fk FD.tan x) - | Isgreater (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.gt x y)) - | Isgreaterequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.ge x y)) - | Isless (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.lt x y)) - | Islessequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.le x y)) - | Islessgreater (x,y) -> Int(ID.c_logor (ID.cast_to IInt (apply_binary FDouble FD.lt x y)) (ID.cast_to IInt (apply_binary FDouble FD.gt x y))) - | Isunordered (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.unordered x y)) - | Fmax (fd, x ,y) -> Float (apply_binary fd FD.fmax x y) - | Fmin (fd, x ,y) -> Float (apply_binary fd FD.fmin x y) - | Sqrt (fk, x) -> Float (apply_unary fk FD.sqrt x) - | Abs (ik, x) -> Int (ID.cast_to ik (apply_abs ik x)) + | Abort, _ -> raise Deadcode + | ThreadExit { ret_val = exp }, _ -> + begin match ThreadId.get_current (Analyses.ask_of_ctx ctx) with + | `Lifted tid -> + ( + let rv = eval_rv ~ctx ctx.local exp in + ctx.sideg (V.thread tid) (G.create_thread rv); + (* TODO: emit thread return event so other analyses are aware? *) + (* TODO: publish still needed? *) + publish_all ctx `Return; (* like normal return *) + let ask = Analyses.ask_of_ctx ctx in + match ThreadId.get_current ask with + | `Lifted tid when ThreadReturn.is_current ask -> + ignore @@ Priv.thread_return ask (priv_getg ctx.global) (priv_sideg ctx.sideg) tid st + | _ -> ()) + | _ -> () + end; + raise Deadcode + | MutexAttrSetType {attr = attr; typ = mtyp}, _ -> + begin + let get_type lval = + let address = eval_lv ~ctx st lval in + AD.type_of address + in + let dst_lval = mkMem ~addr:(Cil.stripCasts attr) ~off:NoOffset in + let dest_typ = get_type dst_lval in + let dest_a = eval_lv ~ctx st dst_lval in + match eval_rv ~ctx st mtyp with + | Int x -> + begin + match ID.to_int x with + | Some z -> + if M.tracing then M.tracel "attr" "setting"; + set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.of_int z)) + | None -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) + end + | _ -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) end - in - begin match lv with - | Some lv_val -> set ~ctx st (eval_lv ~ctx st lv_val) (Cilfacade.typeOfLval lv_val) result - | None -> st - end - (* handling thread creations *) - | ThreadCreate _, _ -> - invalidate_ret_lv ctx.local (* actual results joined via threadspawn *) - (* handling thread joins... sort of *) - | ThreadJoin { thread = id; ret_var }, _ -> - let st' = - (* TODO: should invalidate shallowly? https://github.com/goblint/analyzer/pull/1224#discussion_r1405826773 *) - match eval_rv ~ctx st ret_var with - | Int n when GobOption.exists (Z.equal Z.zero) (ID.to_int n) -> st - | Address ret_a -> - begin match eval_rv ~ctx st id with - | Thread a when ValueDomain.Threads.is_top a -> invalidate ~ctx st [ret_var] - | Thread a -> - let v = List.fold VD.join (VD.bot ()) (List.map (fun x -> G.thread (ctx.global (V.thread x))) (ValueDomain.Threads.elements a)) in - (* TODO: is this type right? *) - set ~ctx st ret_a (Cilfacade.typeOf ret_var) v - | _ -> invalidate ~ctx st [ret_var] + | Identity e, _ -> + begin match lv with + | Some x -> assign ctx x e + | None -> ctx.local + end + (**Floating point classification and trigonometric functions defined in c99*) + | Math { fun_args; }, _ -> + let apply_unary fk float_fun x = + let eval_x = eval_rv ~ctx st x in + begin match eval_x with + | Float float_x -> float_fun (FD.cast_to fk float_x) + | _ -> failwith ("non-floating-point argument in call to function "^f.vname) end - | _ -> invalidate ~ctx st [ret_var] - in - let st' = invalidate_ret_lv st' in - Priv.thread_join (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st' - | Unknown, "__goblint_assume_join" -> - let id = List.hd args in - Priv.thread_join ~force:true (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st - | Alloca size, _ -> begin - match lv with - | Some lv -> - let heap_var = AD.of_var (heap_var true ctx) in - (* ignore @@ printf "alloca will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) - set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] - | _ -> st - end - | Malloc size, _ -> begin - match lv with - | Some lv -> - let heap_var = - if (get_bool "sem.malloc.fail") - then AD.join (AD.of_var (heap_var false ctx)) AD.null_ptr - else AD.of_var (heap_var false ctx) - in - (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) - set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] - | _ -> st - end - | Calloc { count = n; size }, _ -> - begin match lv with - | Some lv -> (* array length is set to one, as num*size is done when turning into `Calloc *) - let heap_var = heap_var false ctx in - let add_null addr = - if get_bool "sem.malloc.fail" - then AD.join addr AD.null_ptr (* calloc can fail and return NULL *) - else addr in - let ik = Cilfacade.ptrdiff_ikind () in - let sizeval = eval_int ~ctx st size in - let countval = eval_int ~ctx st n in - if ID.to_int countval = Some Z.one then ( - set_many ~ctx st [ - (add_null (AD.of_var heap_var), TVoid [], Blob (VD.bot (), sizeval, ZeroInit.calloc)); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_var heap_var))) - ] - ) - else ( - let blobsize = ID.mul (ID.cast_to ik @@ sizeval) (ID.cast_to ik @@ countval) in - (* the memory that was allocated by calloc is set to bottom, but we keep track that it originated from calloc, so when bottom is read from memory allocated by calloc it is turned to zero *) - set_many ~ctx st [ - (add_null (AD.of_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.one) (Blob (VD.bot (), blobsize, ZeroInit.calloc)))); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_mval (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.zero, `NoOffset))))) - ] - ) - | _ -> st - end - | Realloc { ptr = p; size }, _ -> - (* Realloc shouldn't be passed non-dynamically allocated memory *) - check_invalid_mem_dealloc ctx f p; - begin match lv with - | Some lv -> - let p_rv = eval_rv ~ctx st p in - let p_addr = - match p_rv with - | Address a -> a - (* TODO: don't we already have logic for this? *) - | Int i when ID.to_int i = Some Z.zero -> AD.null_ptr - | Int i -> AD.top_ptr - | _ -> AD.top_ptr (* TODO: why does this ever happen? *) - in - let p_addr' = AD.remove NullPtr p_addr in (* realloc with NULL is same as malloc, remove to avoid unknown value from NullPtr access *) - let p_addr_get = get ~ctx st p_addr' None in (* implicitly includes join of malloc value (VD.bot) *) - let size_int = eval_int ~ctx st size in - let heap_val:value = Blob (p_addr_get, size_int, ZeroInit.malloc) in (* copy old contents with new size *) - let heap_addr = AD.of_var (heap_var false ctx) in - let heap_addr' = - if get_bool "sem.malloc.fail" then - AD.join heap_addr AD.null_ptr - else - heap_addr - in - let lv_addr = eval_lv ~ctx st lv in - set_many ~ctx st [ - (heap_addr, TVoid [], heap_val); - (lv_addr, Cilfacade.typeOfLval lv, Address heap_addr'); - ] (* TODO: free (i.e. invalidate) old blob if successful? *) - | None -> - st - end - | Free ptr, _ -> - (* Free shouldn't be passed non-dynamically allocated memory *) - check_invalid_mem_dealloc ctx f ptr; - st - | Assert { exp; refine; _ }, _ -> assert_fn ctx exp refine - | Setjmp { env }, _ -> - let st' = match eval_rv ~ctx st env with - | Address jmp_buf -> - let value = VD.JmpBuf (ValueDomain.JmpBufs.Bufs.singleton (Target (ctx.prev_node, ctx.control_context ())), false) in - let r = set ~ctx st jmp_buf (Cilfacade.typeOf env) value in - if M.tracing then M.tracel "setjmp" "setting setjmp %a on %a -> %a" d_exp env D.pretty st D.pretty r; - r - | _ -> failwith "problem?!" - in - begin match lv with - | Some lv -> - set ~ctx st' (eval_lv ~ctx st lv) (Cilfacade.typeOfLval lv) (Int (ID.of_int IInt Z.zero)) - | None -> st' - end - | Longjmp {env; value}, _ -> - let ensure_not_zero (rv:value) = match rv with - | Int i -> - begin match ID.to_bool i with - | Some true -> rv - | Some false -> - M.error "Must: Longjmp with a value of 0 is silently changed to 1"; - Int (ID.of_int (ID.ikind i) Z.one) - | None -> - M.warn "May: Longjmp with a value of 0 is silently changed to 1"; - let ik = ID.ikind i in - Int (ID.join (ID.meet i (ID.of_excl_list ik [Z.zero])) (ID.of_int ik Z.one)) + in + let apply_binary fk float_fun x y = + let eval_x = eval_rv ~ctx st x in + let eval_y = eval_rv ~ctx st y in + begin match eval_x, eval_y with + | Float float_x, Float float_y -> float_fun (FD.cast_to fk float_x) (FD.cast_to fk float_y) + | _ -> failwith ("non-floating-point argument in call to function "^f.vname) end - | _ -> - M.warn ~category:Program "Arguments to longjmp are strange!"; - rv - in - let rv = ensure_not_zero @@ eval_rv ~ctx ctx.local value in - let t = Cilfacade.typeOf value in - set ~ctx ~t_override:t ctx.local (AD.of_var !longjmp_return) t rv (* Not raising Deadcode here, deadcode is raised at a higher level! *) - | Rand, _ -> - begin match lv with - | Some x -> - let result:value = (Int (ID.starting IInt Z.zero)) in - set ~ctx st (eval_lv ~ctx st x) (Cilfacade.typeOfLval x) result - | None -> st - end - | _, _ -> - let st = - special_unknown_invalidate ctx f args + in + let apply_abs ik x = + let eval_x = eval_rv ~ctx st x in + begin match eval_x with + | Int int_x -> + let xcast = ID.cast_to ik int_x in + (* the absolute value of the most-negative value is out of range for 2'complement types *) + (match (ID.minimal xcast), (ID.minimal (ID.top_of ik)) with + | _, None + | None, _ -> ID.top_of ik + | Some mx, Some mm when Z.equal mx mm -> ID.top_of ik + | _, _ -> + let x1 = ID.neg (ID.meet (ID.ending ik Z.zero) xcast) in + let x2 = ID.meet (ID.starting ik Z.zero) xcast in + ID.join x1 x2 + ) + | _ -> failwith ("non-integer argument in call to function "^f.vname) + end + in + let result:value = + begin match fun_args with + | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> Float (FD.nan_of fk) + | Nan _ -> failwith ("non-pointer argument in call to function "^f.vname) + | Inf fk -> Float (FD.inf_of fk) + | Isfinite x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isfinite x)) + | Isinf x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isinf x)) + | Isnan x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnan x)) + | Isnormal x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnormal x)) + | Signbit x -> Int (ID.cast_to IInt (apply_unary FDouble FD.signbit x)) + | Ceil (fk,x) -> Float (apply_unary fk FD.ceil x) + | Floor (fk,x) -> Float (apply_unary fk FD.floor x) + | Fabs (fk, x) -> Float (apply_unary fk FD.fabs x) + | Acos (fk, x) -> Float (apply_unary fk FD.acos x) + | Asin (fk, x) -> Float (apply_unary fk FD.asin x) + | Atan (fk, x) -> Float (apply_unary fk FD.atan x) + | Atan2 (fk, y, x) -> Float (apply_binary fk (fun y' x' -> FD.atan (FD.div y' x')) y x) + | Cos (fk, x) -> Float (apply_unary fk FD.cos x) + | Sin (fk, x) -> Float (apply_unary fk FD.sin x) + | Tan (fk, x) -> Float (apply_unary fk FD.tan x) + | Isgreater (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.gt x y)) + | Isgreaterequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.ge x y)) + | Isless (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.lt x y)) + | Islessequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.le x y)) + | Islessgreater (x,y) -> Int(ID.c_logor (ID.cast_to IInt (apply_binary FDouble FD.lt x y)) (ID.cast_to IInt (apply_binary FDouble FD.gt x y))) + | Isunordered (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.unordered x y)) + | Fmax (fd, x ,y) -> Float (apply_binary fd FD.fmax x y) + | Fmin (fd, x ,y) -> Float (apply_binary fd FD.fmin x y) + | Sqrt (fk, x) -> Float (apply_unary fk FD.sqrt x) + | Abs (ik, x) -> Int (ID.cast_to ik (apply_abs ik x)) + end + in + begin match lv with + | Some lv_val -> set ~ctx st (eval_lv ~ctx st lv_val) (Cilfacade.typeOfLval lv_val) result + | None -> st + end + (* handling thread creations *) + | ThreadCreate _, _ -> + invalidate_ret_lv ctx.local (* actual results joined via threadspawn *) + (* handling thread joins... sort of *) + | ThreadJoin { thread = id; ret_var }, _ -> + let st' = + (* TODO: should invalidate shallowly? https://github.com/goblint/analyzer/pull/1224#discussion_r1405826773 *) + match eval_rv ~ctx st ret_var with + | Int n when GobOption.exists (Z.equal Z.zero) (ID.to_int n) -> st + | Address ret_a -> + begin match eval_rv ~ctx st id with + | Thread a when ValueDomain.Threads.is_top a -> invalidate ~ctx st [ret_var] + | Thread a -> + let v = List.fold VD.join (VD.bot ()) (List.map (fun x -> G.thread (ctx.global (V.thread x))) (ValueDomain.Threads.elements a)) in + (* TODO: is this type right? *) + set ~ctx st ret_a (Cilfacade.typeOf ret_var) v + | _ -> invalidate ~ctx st [ret_var] + end + | _ -> invalidate ~ctx st [ret_var] + in + let st' = invalidate_ret_lv st' in + Priv.thread_join (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st' + | Unknown, "__goblint_assume_join" -> + let id = List.hd args in + Priv.thread_join ~force:true (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st + | Alloca size, _ -> begin + match lv with + | Some lv -> + let heap_var = AD.of_var (heap_var true ctx) in + (* ignore @@ printf "alloca will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) + set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] + | _ -> st + end + | Malloc size, _ -> begin + match lv with + | Some lv -> + let heap_var = + if (get_bool "sem.malloc.fail") + then AD.join (AD.of_var (heap_var false ctx)) AD.null_ptr + else AD.of_var (heap_var false ctx) + in + (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) + set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] + | _ -> st + end + | Calloc { count = n; size }, _ -> + begin match lv with + | Some lv -> (* array length is set to one, as num*size is done when turning into `Calloc *) + let heap_var = heap_var false ctx in + let add_null addr = + if get_bool "sem.malloc.fail" + then AD.join addr AD.null_ptr (* calloc can fail and return NULL *) + else addr in + let ik = Cilfacade.ptrdiff_ikind () in + let sizeval = eval_int ~ctx st size in + let countval = eval_int ~ctx st n in + if ID.to_int countval = Some Z.one then ( + set_many ~ctx st [ + (add_null (AD.of_var heap_var), TVoid [], Blob (VD.bot (), sizeval, ZeroInit.calloc)); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_var heap_var))) + ] + ) + else ( + let blobsize = ID.mul (ID.cast_to ik @@ sizeval) (ID.cast_to ik @@ countval) in + (* the memory that was allocated by calloc is set to bottom, but we keep track that it originated from calloc, so when bottom is read from memory allocated by calloc it is turned to zero *) + set_many ~ctx st [ + (add_null (AD.of_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.one) (Blob (VD.bot (), blobsize, ZeroInit.calloc)))); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_mval (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.zero, `NoOffset))))) + ] + ) + | _ -> st + end + | Realloc { ptr = p; size }, _ -> + (* Realloc shouldn't be passed non-dynamically allocated memory *) + check_invalid_mem_dealloc ctx f p; + begin match lv with + | Some lv -> + let p_rv = eval_rv ~ctx st p in + let p_addr = + match p_rv with + | Address a -> a + (* TODO: don't we already have logic for this? *) + | Int i when ID.to_int i = Some Z.zero -> AD.null_ptr + | Int i -> AD.top_ptr + | _ -> AD.top_ptr (* TODO: why does this ever happen? *) + in + let p_addr' = AD.remove NullPtr p_addr in (* realloc with NULL is same as malloc, remove to avoid unknown value from NullPtr access *) + let p_addr_get = get ~ctx st p_addr' None in (* implicitly includes join of malloc value (VD.bot) *) + let size_int = eval_int ~ctx st size in + let heap_val:value = Blob (p_addr_get, size_int, ZeroInit.malloc) in (* copy old contents with new size *) + let heap_addr = AD.of_var (heap_var false ctx) in + let heap_addr' = + if get_bool "sem.malloc.fail" then + AD.join heap_addr AD.null_ptr + else + heap_addr + in + let lv_addr = eval_lv ~ctx st lv in + set_many ~ctx st [ + (heap_addr, TVoid [], heap_val); + (lv_addr, Cilfacade.typeOfLval lv, Address heap_addr'); + ] (* TODO: free (i.e. invalidate) old blob if successful? *) + | None -> + st + end + | Free ptr, _ -> + (* Free shouldn't be passed non-dynamically allocated memory *) + check_invalid_mem_dealloc ctx f ptr; + st + | Assert { exp; refine; _ }, _ -> assert_fn ctx exp refine + | Setjmp { env }, _ -> + let st' = match eval_rv ~ctx st env with + | Address jmp_buf -> + let value = VD.JmpBuf (ValueDomain.JmpBufs.Bufs.singleton (Target (ctx.prev_node, ctx.control_context ())), false) in + let r = set ~ctx st jmp_buf (Cilfacade.typeOf env) value in + if M.tracing then M.tracel "setjmp" "setting setjmp %a on %a -> %a" d_exp env D.pretty st D.pretty r; + r + | _ -> failwith "problem?!" + in + begin match lv with + | Some lv -> + set ~ctx st' (eval_lv ~ctx st lv) (Cilfacade.typeOfLval lv) (Int (ID.of_int IInt Z.zero)) + | None -> st' + end + | Longjmp {env; value}, _ -> + let ensure_not_zero (rv:value) = match rv with + | Int i -> + begin match ID.to_bool i with + | Some true -> rv + | Some false -> + M.error "Must: Longjmp with a value of 0 is silently changed to 1"; + Int (ID.of_int (ID.ikind i) Z.one) + | None -> + M.warn "May: Longjmp with a value of 0 is silently changed to 1"; + let ik = ID.ikind i in + Int (ID.join (ID.meet i (ID.of_excl_list ik [Z.zero])) (ID.of_int ik Z.one)) + end + | _ -> + M.warn ~category:Program "Arguments to longjmp are strange!"; + rv + in + let rv = ensure_not_zero @@ eval_rv ~ctx ctx.local value in + let t = Cilfacade.typeOf value in + set ~ctx ~t_override:t ctx.local (AD.of_var !longjmp_return) t rv (* Not raising Deadcode here, deadcode is raised at a higher level! *) + | Rand, _ -> + begin match lv with + | Some x -> + let result:value = (Int (ID.starting IInt Z.zero)) in + set ~ctx st (eval_lv ~ctx st x) (Cilfacade.typeOfLval x) result + | None -> st + end + | _, _ -> + let st = + special_unknown_invalidate ctx f args (* * TODO: invalidate vars reachable via args * publish globals * if single-threaded: *call f*, privatize globals * else: spawn f *) - in - (* invalidate lhs in case of assign *) - invalidate_ret_lv st + in + (* invalidate lhs in case of assign *) + invalidate_ret_lv st in if get_bool "sem.noreturn.dead_code" && Cil.hasAttribute "noreturn" f.vattr then raise Deadcode else st diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 452c78963e..b31e4cd739 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -75,7 +75,7 @@ struct let ik = Cilfacade.get_ikind_exp e in ID.of_bool ik res end - | Queries.Invariant context -> + | Invariant context -> let scope = Node.find_fundec ctx.node in begin match D.remove_vars_not_in_scope scope ctx.local with | None -> Invariant.top() diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index 8ece99d6e8..8942f14f4b 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -564,9 +564,9 @@ struct let r = eq_set_clos e ctx.local in if M.tracing then M.tracel "var_eq" "equalset %a = %a" d_plainexp e Queries.ES.pretty r; r - | Queries.Invariant context when GobConfig.get_bool "witness.invariant.exact" -> (* only exact equalities here *) + (* | Queries.Invariant context when GobConfig.get_bool "witness.invariant.exact" -> (* only exact equalities here *) let scope = Node.find_fundec ctx.node in - D.invariant ~scope ctx.local + D.invariant ~scope ctx.local *) | _ -> Queries.Result.top x let event ctx e octx = diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml index e361dbaa54..0bb02d09d6 100644 --- a/src/witness/witnessConstraints.ml +++ b/src/witness/witnessConstraints.ml @@ -254,11 +254,11 @@ struct (* let (d, _) = List.at (S.elements s) i in *) let (d, _) = List.find (fun (x, _) -> I.to_int x = i) (Dom.bindings (fst ctx.local)) in Spec.query (conv ctx d) q - | Queries.Invariant ({path=Some i; _} as c) -> + | Queries.Invariant ({path=Some i; _} as c) -> Invariant.top() (* TODO: optimize indexing, using inner hashcons somehow? *) (* let (d, _) = List.at (S.elements s) i in *) - let (d, _) = List.find (fun (x, _) -> I.to_int x = i) (Dom.bindings (fst ctx.local)) in - Spec.query (conv ctx d) (Invariant c) + (* let (d, _) = List.find (fun (x, _) -> I.to_int x = i) (Dom.bindings (fst ctx.local)) in + Spec.query (conv ctx d) (Invariant c) *) | _ -> (* join results so that they are sound for all paths *) let module Result = (val Queries.Result.lattice q) in diff --git a/witness_tests.sh b/witness_tests.sh new file mode 100755 index 0000000000..1551d05e68 --- /dev/null +++ b/witness_tests.sh @@ -0,0 +1,14 @@ +#! /usr/bin/bash +programs_dir="tests/regression/83-c2po/" +output_dir="result/witness_tests_output" +use_my_analysis="--set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts" + +`mkdir $output_dir` + +for entry in "$programs_dir"* +do + filename=$(basename -- "$entry") + `./goblint $use_my_analysis $entry --enable witness.yaml.enabled &> $output_dir/$filename.txt` + `./goblint $use_my_analysis $entry --set witness.yaml.validate witness.yml &> $output_dir/${filename}_validation_c2po.txt` + `./goblint $entry --set witness.yaml.validate witness.yml &> $output_dir/${filename}_validation_c2po.txt` +done From 6f64f8f1da4fcb0b8e68adba89e46f9c66724d88 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Sun, 14 Jul 2024 22:54:14 +0200 Subject: [PATCH 246/323] fix invariant --- src/analyses/c2poAnalysis.ml | 10 +++++++++- src/cdomains/c2poDomain.ml | 5 ----- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index b31e4cd739..80ef0c34f9 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -66,6 +66,14 @@ struct | _ -> MayBeEqual.AD.top() *) + let conj_to_invariant ask conjs t = + List.fold (fun a prop -> let exp = T.prop_to_cil prop in + if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; + match eval_guard ask t exp with + | Some true -> Invariant.(a && of_exp exp) + | _ -> a) + (Invariant.top()) conjs + let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in match q with @@ -80,7 +88,7 @@ struct begin match D.remove_vars_not_in_scope scope ctx.local with | None -> Invariant.top() | Some t -> - T.conj_to_invariant (get_normal_form t) + (conj_to_invariant (ask_of_ctx ctx) (get_normal_form t) (Some t)) end (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) | _ -> Result.top q diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 098cfa7eaf..602221721f 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -767,11 +767,6 @@ module CongruenceClosure = struct | _ -> (false, cc) else (false,cc) - let eq_query_opt cc (t1,t2,r) = - match cc with - | None -> false - | Some cc -> fst (eq_query cc (t1,t2,r)) - let block_neq_query cc (t1,t2) = (* we implicitly assume that &x != &y + z *) let (v1,r1),cc = insert cc t1 in From 0568de8fdaec38d9e499ccb559efea11ed5c40fa Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Jul 2024 15:20:33 +0200 Subject: [PATCH 247/323] Revert "now I'm the only one that answers the invariant query" This reverts commit 887ab9816003d98a9787a641497ab5db81956907. --- src/analyses/apron/relationAnalysis.apron.ml | 3 +- src/analyses/base.ml | 669 +++++++++---------- src/analyses/c2poAnalysis.ml | 2 +- src/analyses/varEq.ml | 4 +- src/witness/witnessConstraints.ml | 6 +- witness_tests.sh | 14 - 6 files changed, 341 insertions(+), 357 deletions(-) delete mode 100755 witness_tests.sh diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index aafa581a72..ad99e26b58 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -654,8 +654,7 @@ struct | Queries.IterSysVars (vq, vf) -> let vf' x = vf (Obj.repr x) in Priv.iter_sys_vars ctx.global vq vf' - | Queries.Invariant context -> Invariant.top() - (* query_invariant ctx context *) + | Queries.Invariant context -> query_invariant ctx context | _ -> Result.top q diff --git a/src/analyses/base.ml b/src/analyses/base.ml index c9c1724c6e..29fa74c5a9 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1543,8 +1543,7 @@ struct | Q.IterSysVars (vq, vf) -> let vf' x = vf (Obj.repr (V.priv x)) in Priv.iter_sys_vars (priv_getg ctx.global) vq vf' - | Q.Invariant context -> Invariant.top() - (* query_invariant ctx context *) + | Q.Invariant context -> query_invariant ctx context | Q.InvariantGlobal g -> let g: V.t = Obj.obj g in query_invariant_global ctx g @@ -2445,352 +2444,352 @@ struct end in let st = match desc.special args, f.vname with - | Memset { dest; ch; count; }, _ -> - (* TODO: check count *) - let eval_ch = eval_rv ~ctx st ch in - let dest_a, dest_typ = addr_type_of_exp dest in - let value = - match eval_ch with - | Int i when ID.to_int i = Some Z.zero -> - VD.zero_init_value dest_typ - | _ -> - VD.top_value dest_typ - in - set ~ctx st dest_a dest_typ value - | Bzero { dest; count; }, _ -> - (* TODO: share something with memset special case? *) - (* TODO: check count *) - let dest_a, dest_typ = addr_type_of_exp dest in - let value = VD.zero_init_value dest_typ in - set ~ctx st dest_a dest_typ value - | Memcpy { dest = dst; src; n; }, _ -> (* TODO: use n *) - memory_copying dst src (Some n) - | Strcpy { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_copy ar1 ar2 (eval_n n))) - | Strcat { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_concat ar1 ar2 (eval_n n))) - | Strlen s, _ -> - begin match lv with - | Some lv_val -> - let dest_a = eval_lv ~ctx st lv_val in - let dest_typ = Cilfacade.typeOfLval lv_val in - let v = eval_rv ~ctx st s in - let a = address_from_value v in - let value:value = - (* if s string literal, compute strlen in string literals domain *) - (* TODO: is this reliable? there could be a char* which isn't StrPtr *) - if CilType.Typ.equal (AD.type_of a) charPtrType then - Int (AD.to_string_length a) - (* else compute strlen in array domain *) - else - begin match get ~ctx st a None with - | Array array_s -> Int (CArrays.to_string_length array_s) - | _ -> VD.top_value (unrollType dest_typ) - end in - set ~ctx st dest_a dest_typ value - | None -> st - end - | Strstr { haystack; needle }, _ -> - begin match lv with - | Some lv_val -> - (* check if needle is a substring of haystack in string literals domain if haystack and needle are string literals, - else check in null bytes domain if both haystack and needle are / can be transformed to an array domain representation; - if needle is substring, assign the substring of haystack starting at the first occurrence of needle to dest, - if it surely isn't, assign a null_ptr *) - string_manipulation haystack needle lv true (Some (fun h_a n_a -> Address (AD.substring_extraction h_a n_a))) - (fun h_ar n_ar -> match CArrays.substring_extraction h_ar n_ar with - | CArrays.IsNotSubstr -> Address (AD.null_ptr) - | CArrays.IsSubstrAtIndex0 -> Address (eval_lv ~ctx st (mkMem ~addr:(Cil.stripCasts haystack) ~off:NoOffset)) - | CArrays.IsMaybeSubstr -> Address (AD.join (eval_lv ~ctx st - (mkMem ~addr:(Cil.stripCasts haystack) ~off:(Index (Lazy.force Offset.Index.Exp.any, NoOffset)))) (AD.null_ptr))) - | None -> st - end - | Strcmp { s1; s2; n }, _ -> - begin match lv with - | Some _ -> - (* when s1 and s2 are string literals, compare both completely or their first n characters in the string literals domain; - else compare them in the null bytes array domain if they are / can be transformed to an array domain representation *) - string_manipulation s1 s2 lv false (Some (fun s1_a s2_a -> Int (AD.string_comparison s1_a s2_a (eval_n n)))) - (fun s1_ar s2_ar -> Int (CArrays.string_comparison s1_ar s2_ar (eval_n n))) - | None -> st - end - | Abort, _ -> raise Deadcode - | ThreadExit { ret_val = exp }, _ -> - begin match ThreadId.get_current (Analyses.ask_of_ctx ctx) with - | `Lifted tid -> - ( - let rv = eval_rv ~ctx ctx.local exp in - ctx.sideg (V.thread tid) (G.create_thread rv); - (* TODO: emit thread return event so other analyses are aware? *) - (* TODO: publish still needed? *) - publish_all ctx `Return; (* like normal return *) - let ask = Analyses.ask_of_ctx ctx in - match ThreadId.get_current ask with - | `Lifted tid when ThreadReturn.is_current ask -> - ignore @@ Priv.thread_return ask (priv_getg ctx.global) (priv_sideg ctx.sideg) tid st - | _ -> ()) - | _ -> () - end; - raise Deadcode - | MutexAttrSetType {attr = attr; typ = mtyp}, _ -> - begin - let get_type lval = - let address = eval_lv ~ctx st lval in - AD.type_of address - in - let dst_lval = mkMem ~addr:(Cil.stripCasts attr) ~off:NoOffset in - let dest_typ = get_type dst_lval in - let dest_a = eval_lv ~ctx st dst_lval in - match eval_rv ~ctx st mtyp with - | Int x -> - begin - match ID.to_int x with - | Some z -> - if M.tracing then M.tracel "attr" "setting"; - set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.of_int z)) - | None -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) - end - | _ -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) - end - | Identity e, _ -> - begin match lv with - | Some x -> assign ctx x e - | None -> ctx.local - end - (**Floating point classification and trigonometric functions defined in c99*) - | Math { fun_args; }, _ -> - let apply_unary fk float_fun x = - let eval_x = eval_rv ~ctx st x in - begin match eval_x with - | Float float_x -> float_fun (FD.cast_to fk float_x) - | _ -> failwith ("non-floating-point argument in call to function "^f.vname) - end - in - let apply_binary fk float_fun x y = - let eval_x = eval_rv ~ctx st x in - let eval_y = eval_rv ~ctx st y in - begin match eval_x, eval_y with - | Float float_x, Float float_y -> float_fun (FD.cast_to fk float_x) (FD.cast_to fk float_y) - | _ -> failwith ("non-floating-point argument in call to function "^f.vname) - end - in - let apply_abs ik x = - let eval_x = eval_rv ~ctx st x in - begin match eval_x with - | Int int_x -> - let xcast = ID.cast_to ik int_x in - (* the absolute value of the most-negative value is out of range for 2'complement types *) - (match (ID.minimal xcast), (ID.minimal (ID.top_of ik)) with - | _, None - | None, _ -> ID.top_of ik - | Some mx, Some mm when Z.equal mx mm -> ID.top_of ik - | _, _ -> - let x1 = ID.neg (ID.meet (ID.ending ik Z.zero) xcast) in - let x2 = ID.meet (ID.starting ik Z.zero) xcast in - ID.join x1 x2 - ) - | _ -> failwith ("non-integer argument in call to function "^f.vname) - end + | Memset { dest; ch; count; }, _ -> + (* TODO: check count *) + let eval_ch = eval_rv ~ctx st ch in + let dest_a, dest_typ = addr_type_of_exp dest in + let value = + match eval_ch with + | Int i when ID.to_int i = Some Z.zero -> + VD.zero_init_value dest_typ + | _ -> + VD.top_value dest_typ + in + set ~ctx st dest_a dest_typ value + | Bzero { dest; count; }, _ -> + (* TODO: share something with memset special case? *) + (* TODO: check count *) + let dest_a, dest_typ = addr_type_of_exp dest in + let value = VD.zero_init_value dest_typ in + set ~ctx st dest_a dest_typ value + | Memcpy { dest = dst; src; n; }, _ -> (* TODO: use n *) + memory_copying dst src (Some n) + | Strcpy { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_copy ar1 ar2 (eval_n n))) + | Strcat { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_concat ar1 ar2 (eval_n n))) + | Strlen s, _ -> + begin match lv with + | Some lv_val -> + let dest_a = eval_lv ~ctx st lv_val in + let dest_typ = Cilfacade.typeOfLval lv_val in + let v = eval_rv ~ctx st s in + let a = address_from_value v in + let value:value = + (* if s string literal, compute strlen in string literals domain *) + (* TODO: is this reliable? there could be a char* which isn't StrPtr *) + if CilType.Typ.equal (AD.type_of a) charPtrType then + Int (AD.to_string_length a) + (* else compute strlen in array domain *) + else + begin match get ~ctx st a None with + | Array array_s -> Int (CArrays.to_string_length array_s) + | _ -> VD.top_value (unrollType dest_typ) + end in + set ~ctx st dest_a dest_typ value + | None -> st + end + | Strstr { haystack; needle }, _ -> + begin match lv with + | Some lv_val -> + (* check if needle is a substring of haystack in string literals domain if haystack and needle are string literals, + else check in null bytes domain if both haystack and needle are / can be transformed to an array domain representation; + if needle is substring, assign the substring of haystack starting at the first occurrence of needle to dest, + if it surely isn't, assign a null_ptr *) + string_manipulation haystack needle lv true (Some (fun h_a n_a -> Address (AD.substring_extraction h_a n_a))) + (fun h_ar n_ar -> match CArrays.substring_extraction h_ar n_ar with + | CArrays.IsNotSubstr -> Address (AD.null_ptr) + | CArrays.IsSubstrAtIndex0 -> Address (eval_lv ~ctx st (mkMem ~addr:(Cil.stripCasts haystack) ~off:NoOffset)) + | CArrays.IsMaybeSubstr -> Address (AD.join (eval_lv ~ctx st + (mkMem ~addr:(Cil.stripCasts haystack) ~off:(Index (Lazy.force Offset.Index.Exp.any, NoOffset)))) (AD.null_ptr))) + | None -> st + end + | Strcmp { s1; s2; n }, _ -> + begin match lv with + | Some _ -> + (* when s1 and s2 are string literals, compare both completely or their first n characters in the string literals domain; + else compare them in the null bytes array domain if they are / can be transformed to an array domain representation *) + string_manipulation s1 s2 lv false (Some (fun s1_a s2_a -> Int (AD.string_comparison s1_a s2_a (eval_n n)))) + (fun s1_ar s2_ar -> Int (CArrays.string_comparison s1_ar s2_ar (eval_n n))) + | None -> st + end + | Abort, _ -> raise Deadcode + | ThreadExit { ret_val = exp }, _ -> + begin match ThreadId.get_current (Analyses.ask_of_ctx ctx) with + | `Lifted tid -> + ( + let rv = eval_rv ~ctx ctx.local exp in + ctx.sideg (V.thread tid) (G.create_thread rv); + (* TODO: emit thread return event so other analyses are aware? *) + (* TODO: publish still needed? *) + publish_all ctx `Return; (* like normal return *) + let ask = Analyses.ask_of_ctx ctx in + match ThreadId.get_current ask with + | `Lifted tid when ThreadReturn.is_current ask -> + ignore @@ Priv.thread_return ask (priv_getg ctx.global) (priv_sideg ctx.sideg) tid st + | _ -> ()) + | _ -> () + end; + raise Deadcode + | MutexAttrSetType {attr = attr; typ = mtyp}, _ -> + begin + let get_type lval = + let address = eval_lv ~ctx st lval in + AD.type_of address in - let result:value = - begin match fun_args with - | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> Float (FD.nan_of fk) - | Nan _ -> failwith ("non-pointer argument in call to function "^f.vname) - | Inf fk -> Float (FD.inf_of fk) - | Isfinite x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isfinite x)) - | Isinf x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isinf x)) - | Isnan x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnan x)) - | Isnormal x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnormal x)) - | Signbit x -> Int (ID.cast_to IInt (apply_unary FDouble FD.signbit x)) - | Ceil (fk,x) -> Float (apply_unary fk FD.ceil x) - | Floor (fk,x) -> Float (apply_unary fk FD.floor x) - | Fabs (fk, x) -> Float (apply_unary fk FD.fabs x) - | Acos (fk, x) -> Float (apply_unary fk FD.acos x) - | Asin (fk, x) -> Float (apply_unary fk FD.asin x) - | Atan (fk, x) -> Float (apply_unary fk FD.atan x) - | Atan2 (fk, y, x) -> Float (apply_binary fk (fun y' x' -> FD.atan (FD.div y' x')) y x) - | Cos (fk, x) -> Float (apply_unary fk FD.cos x) - | Sin (fk, x) -> Float (apply_unary fk FD.sin x) - | Tan (fk, x) -> Float (apply_unary fk FD.tan x) - | Isgreater (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.gt x y)) - | Isgreaterequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.ge x y)) - | Isless (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.lt x y)) - | Islessequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.le x y)) - | Islessgreater (x,y) -> Int(ID.c_logor (ID.cast_to IInt (apply_binary FDouble FD.lt x y)) (ID.cast_to IInt (apply_binary FDouble FD.gt x y))) - | Isunordered (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.unordered x y)) - | Fmax (fd, x ,y) -> Float (apply_binary fd FD.fmax x y) - | Fmin (fd, x ,y) -> Float (apply_binary fd FD.fmin x y) - | Sqrt (fk, x) -> Float (apply_unary fk FD.sqrt x) - | Abs (ik, x) -> Int (ID.cast_to ik (apply_abs ik x)) + let dst_lval = mkMem ~addr:(Cil.stripCasts attr) ~off:NoOffset in + let dest_typ = get_type dst_lval in + let dest_a = eval_lv ~ctx st dst_lval in + match eval_rv ~ctx st mtyp with + | Int x -> + begin + match ID.to_int x with + | Some z -> + if M.tracing then M.tracel "attr" "setting"; + set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.of_int z)) + | None -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) end - in - begin match lv with - | Some lv_val -> set ~ctx st (eval_lv ~ctx st lv_val) (Cilfacade.typeOfLval lv_val) result - | None -> st - end - (* handling thread creations *) - | ThreadCreate _, _ -> - invalidate_ret_lv ctx.local (* actual results joined via threadspawn *) - (* handling thread joins... sort of *) - | ThreadJoin { thread = id; ret_var }, _ -> - let st' = - (* TODO: should invalidate shallowly? https://github.com/goblint/analyzer/pull/1224#discussion_r1405826773 *) - match eval_rv ~ctx st ret_var with - | Int n when GobOption.exists (Z.equal Z.zero) (ID.to_int n) -> st - | Address ret_a -> - begin match eval_rv ~ctx st id with - | Thread a when ValueDomain.Threads.is_top a -> invalidate ~ctx st [ret_var] - | Thread a -> - let v = List.fold VD.join (VD.bot ()) (List.map (fun x -> G.thread (ctx.global (V.thread x))) (ValueDomain.Threads.elements a)) in - (* TODO: is this type right? *) - set ~ctx st ret_a (Cilfacade.typeOf ret_var) v - | _ -> invalidate ~ctx st [ret_var] - end - | _ -> invalidate ~ctx st [ret_var] - in - let st' = invalidate_ret_lv st' in - Priv.thread_join (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st' - | Unknown, "__goblint_assume_join" -> - let id = List.hd args in - Priv.thread_join ~force:true (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st - | Alloca size, _ -> begin - match lv with - | Some lv -> - let heap_var = AD.of_var (heap_var true ctx) in - (* ignore @@ printf "alloca will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) - set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] - | _ -> st + | _ -> set ~ctx st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) + end + | Identity e, _ -> + begin match lv with + | Some x -> assign ctx x e + | None -> ctx.local + end + (**Floating point classification and trigonometric functions defined in c99*) + | Math { fun_args; }, _ -> + let apply_unary fk float_fun x = + let eval_x = eval_rv ~ctx st x in + begin match eval_x with + | Float float_x -> float_fun (FD.cast_to fk float_x) + | _ -> failwith ("non-floating-point argument in call to function "^f.vname) end - | Malloc size, _ -> begin - match lv with - | Some lv -> - let heap_var = - if (get_bool "sem.malloc.fail") - then AD.join (AD.of_var (heap_var false ctx)) AD.null_ptr - else AD.of_var (heap_var false ctx) - in - (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) - set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] - | _ -> st + in + let apply_binary fk float_fun x y = + let eval_x = eval_rv ~ctx st x in + let eval_y = eval_rv ~ctx st y in + begin match eval_x, eval_y with + | Float float_x, Float float_y -> float_fun (FD.cast_to fk float_x) (FD.cast_to fk float_y) + | _ -> failwith ("non-floating-point argument in call to function "^f.vname) end - | Calloc { count = n; size }, _ -> - begin match lv with - | Some lv -> (* array length is set to one, as num*size is done when turning into `Calloc *) - let heap_var = heap_var false ctx in - let add_null addr = - if get_bool "sem.malloc.fail" - then AD.join addr AD.null_ptr (* calloc can fail and return NULL *) - else addr in - let ik = Cilfacade.ptrdiff_ikind () in - let sizeval = eval_int ~ctx st size in - let countval = eval_int ~ctx st n in - if ID.to_int countval = Some Z.one then ( - set_many ~ctx st [ - (add_null (AD.of_var heap_var), TVoid [], Blob (VD.bot (), sizeval, ZeroInit.calloc)); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_var heap_var))) - ] - ) - else ( - let blobsize = ID.mul (ID.cast_to ik @@ sizeval) (ID.cast_to ik @@ countval) in - (* the memory that was allocated by calloc is set to bottom, but we keep track that it originated from calloc, so when bottom is read from memory allocated by calloc it is turned to zero *) - set_many ~ctx st [ - (add_null (AD.of_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.one) (Blob (VD.bot (), blobsize, ZeroInit.calloc)))); - (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_mval (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.zero, `NoOffset))))) - ] + in + let apply_abs ik x = + let eval_x = eval_rv ~ctx st x in + begin match eval_x with + | Int int_x -> + let xcast = ID.cast_to ik int_x in + (* the absolute value of the most-negative value is out of range for 2'complement types *) + (match (ID.minimal xcast), (ID.minimal (ID.top_of ik)) with + | _, None + | None, _ -> ID.top_of ik + | Some mx, Some mm when Z.equal mx mm -> ID.top_of ik + | _, _ -> + let x1 = ID.neg (ID.meet (ID.ending ik Z.zero) xcast) in + let x2 = ID.meet (ID.starting ik Z.zero) xcast in + ID.join x1 x2 ) - | _ -> st - end - | Realloc { ptr = p; size }, _ -> - (* Realloc shouldn't be passed non-dynamically allocated memory *) - check_invalid_mem_dealloc ctx f p; - begin match lv with - | Some lv -> - let p_rv = eval_rv ~ctx st p in - let p_addr = - match p_rv with - | Address a -> a - (* TODO: don't we already have logic for this? *) - | Int i when ID.to_int i = Some Z.zero -> AD.null_ptr - | Int i -> AD.top_ptr - | _ -> AD.top_ptr (* TODO: why does this ever happen? *) - in - let p_addr' = AD.remove NullPtr p_addr in (* realloc with NULL is same as malloc, remove to avoid unknown value from NullPtr access *) - let p_addr_get = get ~ctx st p_addr' None in (* implicitly includes join of malloc value (VD.bot) *) - let size_int = eval_int ~ctx st size in - let heap_val:value = Blob (p_addr_get, size_int, ZeroInit.malloc) in (* copy old contents with new size *) - let heap_addr = AD.of_var (heap_var false ctx) in - let heap_addr' = - if get_bool "sem.malloc.fail" then - AD.join heap_addr AD.null_ptr - else - heap_addr - in - let lv_addr = eval_lv ~ctx st lv in - set_many ~ctx st [ - (heap_addr, TVoid [], heap_val); - (lv_addr, Cilfacade.typeOfLval lv, Address heap_addr'); - ] (* TODO: free (i.e. invalidate) old blob if successful? *) - | None -> - st + | _ -> failwith ("non-integer argument in call to function "^f.vname) end - | Free ptr, _ -> - (* Free shouldn't be passed non-dynamically allocated memory *) - check_invalid_mem_dealloc ctx f ptr; - st - | Assert { exp; refine; _ }, _ -> assert_fn ctx exp refine - | Setjmp { env }, _ -> - let st' = match eval_rv ~ctx st env with - | Address jmp_buf -> - let value = VD.JmpBuf (ValueDomain.JmpBufs.Bufs.singleton (Target (ctx.prev_node, ctx.control_context ())), false) in - let r = set ~ctx st jmp_buf (Cilfacade.typeOf env) value in - if M.tracing then M.tracel "setjmp" "setting setjmp %a on %a -> %a" d_exp env D.pretty st D.pretty r; - r - | _ -> failwith "problem?!" - in - begin match lv with - | Some lv -> - set ~ctx st' (eval_lv ~ctx st lv) (Cilfacade.typeOfLval lv) (Int (ID.of_int IInt Z.zero)) - | None -> st' - end - | Longjmp {env; value}, _ -> - let ensure_not_zero (rv:value) = match rv with - | Int i -> - begin match ID.to_bool i with - | Some true -> rv - | Some false -> - M.error "Must: Longjmp with a value of 0 is silently changed to 1"; - Int (ID.of_int (ID.ikind i) Z.one) - | None -> - M.warn "May: Longjmp with a value of 0 is silently changed to 1"; - let ik = ID.ikind i in - Int (ID.join (ID.meet i (ID.of_excl_list ik [Z.zero])) (ID.of_int ik Z.one)) - end - | _ -> - M.warn ~category:Program "Arguments to longjmp are strange!"; - rv - in - let rv = ensure_not_zero @@ eval_rv ~ctx ctx.local value in - let t = Cilfacade.typeOf value in - set ~ctx ~t_override:t ctx.local (AD.of_var !longjmp_return) t rv (* Not raising Deadcode here, deadcode is raised at a higher level! *) - | Rand, _ -> - begin match lv with - | Some x -> - let result:value = (Int (ID.starting IInt Z.zero)) in - set ~ctx st (eval_lv ~ctx st x) (Cilfacade.typeOfLval x) result - | None -> st + in + let result:value = + begin match fun_args with + | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> Float (FD.nan_of fk) + | Nan _ -> failwith ("non-pointer argument in call to function "^f.vname) + | Inf fk -> Float (FD.inf_of fk) + | Isfinite x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isfinite x)) + | Isinf x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isinf x)) + | Isnan x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnan x)) + | Isnormal x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnormal x)) + | Signbit x -> Int (ID.cast_to IInt (apply_unary FDouble FD.signbit x)) + | Ceil (fk,x) -> Float (apply_unary fk FD.ceil x) + | Floor (fk,x) -> Float (apply_unary fk FD.floor x) + | Fabs (fk, x) -> Float (apply_unary fk FD.fabs x) + | Acos (fk, x) -> Float (apply_unary fk FD.acos x) + | Asin (fk, x) -> Float (apply_unary fk FD.asin x) + | Atan (fk, x) -> Float (apply_unary fk FD.atan x) + | Atan2 (fk, y, x) -> Float (apply_binary fk (fun y' x' -> FD.atan (FD.div y' x')) y x) + | Cos (fk, x) -> Float (apply_unary fk FD.cos x) + | Sin (fk, x) -> Float (apply_unary fk FD.sin x) + | Tan (fk, x) -> Float (apply_unary fk FD.tan x) + | Isgreater (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.gt x y)) + | Isgreaterequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.ge x y)) + | Isless (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.lt x y)) + | Islessequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.le x y)) + | Islessgreater (x,y) -> Int(ID.c_logor (ID.cast_to IInt (apply_binary FDouble FD.lt x y)) (ID.cast_to IInt (apply_binary FDouble FD.gt x y))) + | Isunordered (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.unordered x y)) + | Fmax (fd, x ,y) -> Float (apply_binary fd FD.fmax x y) + | Fmin (fd, x ,y) -> Float (apply_binary fd FD.fmin x y) + | Sqrt (fk, x) -> Float (apply_unary fk FD.sqrt x) + | Abs (ik, x) -> Int (ID.cast_to ik (apply_abs ik x)) end - | _, _ -> - let st = - special_unknown_invalidate ctx f args + in + begin match lv with + | Some lv_val -> set ~ctx st (eval_lv ~ctx st lv_val) (Cilfacade.typeOfLval lv_val) result + | None -> st + end + (* handling thread creations *) + | ThreadCreate _, _ -> + invalidate_ret_lv ctx.local (* actual results joined via threadspawn *) + (* handling thread joins... sort of *) + | ThreadJoin { thread = id; ret_var }, _ -> + let st' = + (* TODO: should invalidate shallowly? https://github.com/goblint/analyzer/pull/1224#discussion_r1405826773 *) + match eval_rv ~ctx st ret_var with + | Int n when GobOption.exists (Z.equal Z.zero) (ID.to_int n) -> st + | Address ret_a -> + begin match eval_rv ~ctx st id with + | Thread a when ValueDomain.Threads.is_top a -> invalidate ~ctx st [ret_var] + | Thread a -> + let v = List.fold VD.join (VD.bot ()) (List.map (fun x -> G.thread (ctx.global (V.thread x))) (ValueDomain.Threads.elements a)) in + (* TODO: is this type right? *) + set ~ctx st ret_a (Cilfacade.typeOf ret_var) v + | _ -> invalidate ~ctx st [ret_var] + end + | _ -> invalidate ~ctx st [ret_var] + in + let st' = invalidate_ret_lv st' in + Priv.thread_join (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st' + | Unknown, "__goblint_assume_join" -> + let id = List.hd args in + Priv.thread_join ~force:true (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st + | Alloca size, _ -> begin + match lv with + | Some lv -> + let heap_var = AD.of_var (heap_var true ctx) in + (* ignore @@ printf "alloca will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) + set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] + | _ -> st + end + | Malloc size, _ -> begin + match lv with + | Some lv -> + let heap_var = + if (get_bool "sem.malloc.fail") + then AD.join (AD.of_var (heap_var false ctx)) AD.null_ptr + else AD.of_var (heap_var false ctx) + in + (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ~ctx size); *) + set_many ~ctx st [(heap_var, TVoid [], Blob (VD.bot (), eval_int ~ctx st size, ZeroInit.malloc)); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address heap_var)] + | _ -> st + end + | Calloc { count = n; size }, _ -> + begin match lv with + | Some lv -> (* array length is set to one, as num*size is done when turning into `Calloc *) + let heap_var = heap_var false ctx in + let add_null addr = + if get_bool "sem.malloc.fail" + then AD.join addr AD.null_ptr (* calloc can fail and return NULL *) + else addr in + let ik = Cilfacade.ptrdiff_ikind () in + let sizeval = eval_int ~ctx st size in + let countval = eval_int ~ctx st n in + if ID.to_int countval = Some Z.one then ( + set_many ~ctx st [ + (add_null (AD.of_var heap_var), TVoid [], Blob (VD.bot (), sizeval, ZeroInit.calloc)); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_var heap_var))) + ] + ) + else ( + let blobsize = ID.mul (ID.cast_to ik @@ sizeval) (ID.cast_to ik @@ countval) in + (* the memory that was allocated by calloc is set to bottom, but we keep track that it originated from calloc, so when bottom is read from memory allocated by calloc it is turned to zero *) + set_many ~ctx st [ + (add_null (AD.of_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.one) (Blob (VD.bot (), blobsize, ZeroInit.calloc)))); + (eval_lv ~ctx st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_mval (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) Z.zero, `NoOffset))))) + ] + ) + | _ -> st + end + | Realloc { ptr = p; size }, _ -> + (* Realloc shouldn't be passed non-dynamically allocated memory *) + check_invalid_mem_dealloc ctx f p; + begin match lv with + | Some lv -> + let p_rv = eval_rv ~ctx st p in + let p_addr = + match p_rv with + | Address a -> a + (* TODO: don't we already have logic for this? *) + | Int i when ID.to_int i = Some Z.zero -> AD.null_ptr + | Int i -> AD.top_ptr + | _ -> AD.top_ptr (* TODO: why does this ever happen? *) + in + let p_addr' = AD.remove NullPtr p_addr in (* realloc with NULL is same as malloc, remove to avoid unknown value from NullPtr access *) + let p_addr_get = get ~ctx st p_addr' None in (* implicitly includes join of malloc value (VD.bot) *) + let size_int = eval_int ~ctx st size in + let heap_val:value = Blob (p_addr_get, size_int, ZeroInit.malloc) in (* copy old contents with new size *) + let heap_addr = AD.of_var (heap_var false ctx) in + let heap_addr' = + if get_bool "sem.malloc.fail" then + AD.join heap_addr AD.null_ptr + else + heap_addr + in + let lv_addr = eval_lv ~ctx st lv in + set_many ~ctx st [ + (heap_addr, TVoid [], heap_val); + (lv_addr, Cilfacade.typeOfLval lv, Address heap_addr'); + ] (* TODO: free (i.e. invalidate) old blob if successful? *) + | None -> + st + end + | Free ptr, _ -> + (* Free shouldn't be passed non-dynamically allocated memory *) + check_invalid_mem_dealloc ctx f ptr; + st + | Assert { exp; refine; _ }, _ -> assert_fn ctx exp refine + | Setjmp { env }, _ -> + let st' = match eval_rv ~ctx st env with + | Address jmp_buf -> + let value = VD.JmpBuf (ValueDomain.JmpBufs.Bufs.singleton (Target (ctx.prev_node, ctx.control_context ())), false) in + let r = set ~ctx st jmp_buf (Cilfacade.typeOf env) value in + if M.tracing then M.tracel "setjmp" "setting setjmp %a on %a -> %a" d_exp env D.pretty st D.pretty r; + r + | _ -> failwith "problem?!" + in + begin match lv with + | Some lv -> + set ~ctx st' (eval_lv ~ctx st lv) (Cilfacade.typeOfLval lv) (Int (ID.of_int IInt Z.zero)) + | None -> st' + end + | Longjmp {env; value}, _ -> + let ensure_not_zero (rv:value) = match rv with + | Int i -> + begin match ID.to_bool i with + | Some true -> rv + | Some false -> + M.error "Must: Longjmp with a value of 0 is silently changed to 1"; + Int (ID.of_int (ID.ikind i) Z.one) + | None -> + M.warn "May: Longjmp with a value of 0 is silently changed to 1"; + let ik = ID.ikind i in + Int (ID.join (ID.meet i (ID.of_excl_list ik [Z.zero])) (ID.of_int ik Z.one)) + end + | _ -> + M.warn ~category:Program "Arguments to longjmp are strange!"; + rv + in + let rv = ensure_not_zero @@ eval_rv ~ctx ctx.local value in + let t = Cilfacade.typeOf value in + set ~ctx ~t_override:t ctx.local (AD.of_var !longjmp_return) t rv (* Not raising Deadcode here, deadcode is raised at a higher level! *) + | Rand, _ -> + begin match lv with + | Some x -> + let result:value = (Int (ID.starting IInt Z.zero)) in + set ~ctx st (eval_lv ~ctx st x) (Cilfacade.typeOfLval x) result + | None -> st + end + | _, _ -> + let st = + special_unknown_invalidate ctx f args (* * TODO: invalidate vars reachable via args * publish globals * if single-threaded: *call f*, privatize globals * else: spawn f *) - in - (* invalidate lhs in case of assign *) - invalidate_ret_lv st + in + (* invalidate lhs in case of assign *) + invalidate_ret_lv st in if get_bool "sem.noreturn.dead_code" && Cil.hasAttribute "noreturn" f.vattr then raise Deadcode else st diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 80ef0c34f9..00ac0ebc6d 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -83,7 +83,7 @@ struct let ik = Cilfacade.get_ikind_exp e in ID.of_bool ik res end - | Invariant context -> + | Queries.Invariant context -> let scope = Node.find_fundec ctx.node in begin match D.remove_vars_not_in_scope scope ctx.local with | None -> Invariant.top() diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index 8942f14f4b..8ece99d6e8 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -564,9 +564,9 @@ struct let r = eq_set_clos e ctx.local in if M.tracing then M.tracel "var_eq" "equalset %a = %a" d_plainexp e Queries.ES.pretty r; r - (* | Queries.Invariant context when GobConfig.get_bool "witness.invariant.exact" -> (* only exact equalities here *) + | Queries.Invariant context when GobConfig.get_bool "witness.invariant.exact" -> (* only exact equalities here *) let scope = Node.find_fundec ctx.node in - D.invariant ~scope ctx.local *) + D.invariant ~scope ctx.local | _ -> Queries.Result.top x let event ctx e octx = diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml index 0bb02d09d6..e361dbaa54 100644 --- a/src/witness/witnessConstraints.ml +++ b/src/witness/witnessConstraints.ml @@ -254,11 +254,11 @@ struct (* let (d, _) = List.at (S.elements s) i in *) let (d, _) = List.find (fun (x, _) -> I.to_int x = i) (Dom.bindings (fst ctx.local)) in Spec.query (conv ctx d) q - | Queries.Invariant ({path=Some i; _} as c) -> Invariant.top() + | Queries.Invariant ({path=Some i; _} as c) -> (* TODO: optimize indexing, using inner hashcons somehow? *) (* let (d, _) = List.at (S.elements s) i in *) - (* let (d, _) = List.find (fun (x, _) -> I.to_int x = i) (Dom.bindings (fst ctx.local)) in - Spec.query (conv ctx d) (Invariant c) *) + let (d, _) = List.find (fun (x, _) -> I.to_int x = i) (Dom.bindings (fst ctx.local)) in + Spec.query (conv ctx d) (Invariant c) | _ -> (* join results so that they are sound for all paths *) let module Result = (val Queries.Result.lattice q) in diff --git a/witness_tests.sh b/witness_tests.sh deleted file mode 100755 index 1551d05e68..0000000000 --- a/witness_tests.sh +++ /dev/null @@ -1,14 +0,0 @@ -#! /usr/bin/bash -programs_dir="tests/regression/83-c2po/" -output_dir="result/witness_tests_output" -use_my_analysis="--set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts" - -`mkdir $output_dir` - -for entry in "$programs_dir"* -do - filename=$(basename -- "$entry") - `./goblint $use_my_analysis $entry --enable witness.yaml.enabled &> $output_dir/$filename.txt` - `./goblint $use_my_analysis $entry --set witness.yaml.validate witness.yml &> $output_dir/${filename}_validation_c2po.txt` - `./goblint $entry --set witness.yaml.validate witness.yml &> $output_dir/${filename}_validation_c2po.txt` -done From be00c1dff097b582de61849b45b1c5c3b61221ef Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Jul 2024 15:43:07 +0200 Subject: [PATCH 248/323] removed unused function and added tracing --- src/cdomains/unionFind.ml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index c765559891..6dddf67cd2 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -83,7 +83,9 @@ module T = struct if List.is_empty compinfo.cfields then Z.zero else get_size_in_bits (List.first compinfo.cfields).ftype *) | _ -> match Z.of_int (bitsSizeOf typ) with - | exception GoblintCil__Cil.SizeOfError (msg,_) -> raise (UnsupportedCilExpression msg) + | exception GoblintCil__Cil.SizeOfError (msg,_) when msg ="abstract type"-> Z.one + | exception GoblintCil__Cil.SizeOfError (msg,_) -> + raise (UnsupportedCilExpression msg) | s -> s let show_type exp = @@ -246,9 +248,11 @@ module T = struct Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) let to_cil_sum off cil_t = - if Z.(equal zero off) then cil_t else - let typ = typeOf cil_t in - BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) + let res = + if Z.(equal zero off) then cil_t else + let typ = typeOf cil_t in + BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) + in if M.tracing then M.trace "c2po-2cil" "exp: %a; offset: %s; res: %a" d_exp cil_t (Z.to_string off) d_exp res;res let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with | Some i -> i From 249e59538f000598c04df71aa52e5aaa12ba619c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Jul 2024 16:25:56 +0200 Subject: [PATCH 249/323] fix name of function --- src/cdomains/c2poDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 5879477875..f1d328ee6a 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -122,7 +122,7 @@ module D = struct else (if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); - let cc = fst(widen_eq a b) in + let cc = fst(widen_eq_no_automata a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) From 18b3c105ad9c02341277d04c55288e272f71b48c Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Jul 2024 16:31:45 +0200 Subject: [PATCH 250/323] use get_conjunction instead of get_noemal_form for meet --- src/cdomains/c2poDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index f1d328ee6a..93b3ede0cc 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -142,7 +142,7 @@ module D = struct if a == b then a' else - match get_normal_form a with + match get_conjunction a with | [] -> b' | a_conj -> meet_conjs_opt a_conj b' From b08fa5603a67460d331da17f97ae62bcbf939fbf Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 15 Jul 2024 16:42:00 +0200 Subject: [PATCH 251/323] fix indentation --- src/analyses/c2poAnalysis.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 00ac0ebc6d..97b3b32956 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -66,13 +66,13 @@ struct | _ -> MayBeEqual.AD.top() *) - let conj_to_invariant ask conjs t = - List.fold (fun a prop -> let exp = T.prop_to_cil prop in - if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; - match eval_guard ask t exp with - | Some true -> Invariant.(a && of_exp exp) - | _ -> a) - (Invariant.top()) conjs + let conj_to_invariant ask conjs t = + List.fold (fun a prop -> let exp = T.prop_to_cil prop in + if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; + match eval_guard ask t exp with + | Some true -> Invariant.(a && of_exp exp) + | _ -> a) + (Invariant.top()) conjs let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in @@ -88,7 +88,7 @@ struct begin match D.remove_vars_not_in_scope scope ctx.local with | None -> Invariant.top() | Some t -> - (conj_to_invariant (ask_of_ctx ctx) (get_normal_form t) (Some t)) + (conj_to_invariant (ask_of_ctx ctx) (get_normal_form t) (Some t)) end (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) | _ -> Result.top q From 82a5cca52fde9343a90f416dcce559fe522f04bc Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 16 Jul 2024 15:20:10 +0200 Subject: [PATCH 252/323] re-add min_repr, but it doesn't quite work yet --- src/analyses/c2poAnalysis.ml | 9 ++-- src/cdomains/c2poDomain.ml | 78 +++++++++++++++---------------- src/cdomains/congruenceClosure.ml | 45 +++++++++++++----- 3 files changed, 76 insertions(+), 56 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index f9b755321c..9f753fc739 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -107,7 +107,7 @@ struct D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo lval_t - | exception (T.UnsupportedCilExpression _) -> D.top () + | exception (T.UnsupportedCilExpression _) -> D.top () (*TODO count how many we have here*) (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. This should almost never happen. @@ -121,18 +121,18 @@ struct let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in - let res = meet_conjs_opt valid_props ctx.local in + let res = remove_min_repr (meet_conjs_opt valid_props ctx.local) in if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s; is_bot: %b\n" d_exp e pos (show_conj valid_props) (D.is_bot res); if D.is_bot res then raise Deadcode; res - let body ctx f = ctx.local (*DONE*) + let body ctx f = ctx.local let assign_return ask t return_var expr = (* the return value is not stored on the heap, therefore we don't need to remove any terms *) match T.of_cil ask expr with - | (Some term, Some offset) -> meet_conjs_opt [Equal (return_var, term, offset)] t + | (Some term, Some offset) -> remove_min_repr (meet_conjs_opt [Equal (return_var, term, offset)] t) | _ -> t let return ctx exp_opt f = @@ -142,7 +142,6 @@ struct | None -> ctx.local in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res - let add_new_block t ask lval = (* ignore assignments to values that are not 64 bits *) let lval_t = typeOfLval lval in diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 93b3ede0cc..a219b33b2b 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -32,7 +32,7 @@ module D = struct match x,y with | None, None -> true | Some cc1, Some cc2 -> - if cc1 == cc2 then + if exactly_equal cc1 cc2 then true else (* add all terms to both elements *) @@ -43,22 +43,22 @@ module D = struct && equal_diseqs cc1 cc2 && equal_bldis cc1 cc2 | _ -> false - in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res + in if M.tracing then M.trace "c2po-equal" "equal eq classes. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res let equal_min_repr x y = - if x == y then - true - else - let res = match x, y with - | Some x, Some y -> + let res = match x, y with + | Some x, Some y -> + if exactly_equal x y then + true + else (T.props_equal (get_normal_form x) (get_normal_form y)) - | None, None -> true - | _ -> false - in if M.tracing then M.trace "c2po-equal" "equal. %b\nx=\n%s\ny=\n%s" res (show x) (show y);res + | None, None -> true + | _ -> false + in if M.tracing then M.trace "c2po-equal" "equal min repr. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res let equal a b = if GobConfig.get_bool "ana.c2po.normal_form" then equal_min_repr a b else equal_standard a b - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = MRMap.empty; diseq = Disequalities.empty; bldis = BlDis.empty} + let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = None; diseq = Disequalities.empty; bldis = BlDis.empty} let init () = init_congruence [] @@ -70,24 +70,24 @@ module D = struct TUF.is_empty cc.uf && Disequalities.is_empty cc.diseq && BlDis.is_empty cc.bldis let join_automaton a b = - if a == b then - a - else - let res = - match a,b with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2) - in - if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" - (show_all res); - res + let res = + match a,b with + | None, b -> b + | a, None -> a + | Some a, Some b -> + if exactly_equal a b then + Some a + else + (if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all (Some a)) (show_all (Some b)); + let cc = fst(join_eq a b) in + let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in + Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) + in + if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" + (show_all res); + res let join_eq_classes a' b' = let res = @@ -95,12 +95,12 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> - if a == b then + if exactly_equal a b then a' else (if M.tracing then M.tracel "c2po-join" "JOIN EQ CLASSES. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in + let cc = fst(join_eq_no_automata a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) @@ -108,6 +108,7 @@ module D = struct if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); res + let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then (if M.tracing then M.trace "c2po-join" "Join Automaton"; join_automaton a b) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_eq_classes a b) @@ -117,7 +118,7 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> - if a == b then + if exactly_equal a b then a' else (if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" @@ -139,12 +140,12 @@ module D = struct | None, _ -> None | _, None -> None | Some a, Some b -> - if a == b then + if exactly_equal a b then a' else match get_conjunction a with | [] -> b' - | a_conj -> meet_conjs_opt a_conj b' + | a_conj -> remove_min_repr (meet_conjs_opt a_conj b') let leq x y = equal (meet x y) x @@ -153,13 +154,12 @@ module D = struct | None, _ -> None | _, None -> None | Some a, Some b -> - if a == b then + if exactly_equal a b then a' else let b_conj = List.filter - (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) - (get_conjunction b) in - meet_conjs_opt b_conj (Some a) + (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_conjunction b) in + remove_min_repr (meet_conjs_opt b_conj (Some a)) let pretty_diff () (x,y) = Pretty.dprintf "" @@ -170,7 +170,7 @@ module D = struct (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) - (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep x.min_repr))) + (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep_opt x.min_repr))) (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) | None -> BatPrintf.fprintf f "\nbottom\n\n" diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 4d28f1db33..b3b0e583ff 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -481,6 +481,11 @@ module CongruenceClosure = struct in List.fold_left show_one_rep "" (bindings min_representatives) + let show_min_rep_opt min_repr_opt = + match min_repr_opt with + | None -> "None" + | Some min_repr -> show_min_rep min_repr + let rec update_min_repr (uf, set, map) min_representatives = function | [] -> min_representatives, uf | state::queue -> (* process all outgoing edges in order of ascending edge labels *) @@ -567,7 +572,7 @@ module CongruenceClosure = struct type t = {uf: TUF.t; set: SSet.t; map: LMap.t; - min_repr: MRMap.t; + min_repr: MRMap.t option; diseq: Disequalities.t; bldis: BlDis.t} [@@deriving eq, ord, hash] @@ -590,10 +595,25 @@ module CongruenceClosure = struct (LMap.zmap_bindings zmap))) (LMap.bindings map) + let compute_min_repr_if_necessary cc = + match cc.min_repr with + | None -> let min_repr, uf = + MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in + {cc with min_repr = Some min_repr; uf}, min_repr + | Some min_repr -> cc, min_repr + + let remove_min_repr = function + | None -> None + | Some cc -> Some {cc with min_repr=None} + + let exactly_equal cc1 cc2 = + cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = + let cc, min_repr = compute_min_repr_if_necessary cc in let normalize_equality (t1, t2, z) = if T.equal t1 t2 && Z.(equal z zero) then None else Some (Equal (t1, t2, z)) in @@ -601,39 +621,39 @@ module CongruenceClosure = struct let atoms = SSet.get_atoms cc.set in List.filter_map (fun atom -> let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in - let (min_state, min_z) = MRMap.find rep_state cc.min_repr in + let (min_state, min_z) = MRMap.find rep_state min_repr in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms in let conjunctions_of_transitions = let transitions = get_transitions (cc.uf, cc.map) in List.filter_map (fun (z,s,(s',z')) -> - let (min_state, min_z) = MRMap.find s cc.min_repr in - let (min_state', min_z') = MRMap.find s' cc.min_repr in + let (min_state, min_z) = MRMap.find s min_repr in + let (min_state', min_z') = MRMap.find s' min_repr in normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) ) transitions in (*disequalities*) let disequalities = Disequalities.get_disequalities cc.diseq in (* find disequalities between min_repr *) let normalize_disequality (t1, t2, z) = - let (min_state1, min_z1) = MRMap.find t1 cc.min_repr in - let (min_state2, min_z2) = MRMap.find t2 cc.min_repr in + let (min_state1, min_z1) = MRMap.find t1 min_repr in + let (min_state2, min_z2) = MRMap.find t2 min_repr in let new_offset = Z.(-min_z2 + min_z1 + z) in if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) else Nequal (min_state2, min_state1, Z.(-new_offset)) in - if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep cc.min_repr) (LMap.show_map cc.map); + if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep min_repr) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in (* block disequalities *) let normalize_bldis t = match t with | BlNequal (t1,t2) -> let min_state1 = - begin match MRMap.find_opt t1 cc.min_repr with + begin match MRMap.find_opt t1 min_repr with | None -> t1 | Some (a,_) -> a end in let min_state2 = - begin match MRMap.find_opt t2 cc.min_repr with + begin match MRMap.find_opt t2 min_repr with | None -> t2 | Some (a,_) -> a end in @@ -696,6 +716,8 @@ module CongruenceClosure = struct ^ (Disequalities.show_neq x.diseq) ^ "\nBlock diseqs:\n" ^ show_conj(BlDis.to_conj x.bldis) + ^ "\nMin repr:\n" + ^ MRMap.show_min_rep_opt x.min_repr (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) @@ -719,8 +741,7 @@ module CongruenceClosure = struct let (set, map) = SSet.subterms_of_conj conj in let uf = SSet.elements set |> TUF.init in - let min_repr = MRMap.initial_minimal_representatives set in - {uf; set; map; min_repr; diseq = Disequalities.empty; bldis=BlDis.empty} + {uf; set; map; min_repr=None; diseq = Disequalities.empty; bldis=BlDis.empty} (** closure of disequalities *) let congruence_neq cc neg = @@ -1103,7 +1124,7 @@ module CongruenceClosure = struct let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in if M.tracing then M.trace "c2po" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" (show_all old_cc) (show_all {uf=cc.uf; set = cc.set; map = cc.map; min_repr=cc.min_repr; diseq=cc.diseq; bldis}); - Some {uf=cc.uf; set = cc.set; map = cc.map; min_repr=cc.min_repr; diseq=cc.diseq; bldis} + Some {uf=cc.uf; set = cc.set; map = cc.map; min_repr=None; diseq=cc.diseq; bldis} | None -> None end | _,None -> None From 690eb44e7a103c594ad2d51c4d6563e61a0770ec Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 16 Jul 2024 15:26:32 +0200 Subject: [PATCH 253/323] remove init_congruence --- src/cdomains/c2poDomain.ml | 4 ++-- src/cdomains/congruenceClosure.ml | 27 +++++---------------------- src/cdomains/unionFind.ml | 3 --- 3 files changed, 7 insertions(+), 27 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index a219b33b2b..6100d5d4a0 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -58,9 +58,9 @@ module D = struct let equal a b = if GobConfig.get_bool "ana.c2po.normal_form" then equal_min_repr a b else equal_standard a b - let empty () = Some {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = None; diseq = Disequalities.empty; bldis = BlDis.empty} + let empty () = Some init_cc - let init () = init_congruence [] + let init () = empty () let bot () = None let is_bot x = Option.is_none x diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index b3b0e583ff..8c12af67da 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -737,11 +737,8 @@ module CongruenceClosure = struct - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. *) - let init_cc conj = - let (set, map) = SSet.subterms_of_conj conj in - let uf = SSet.elements set |> - TUF.init in - {uf; set; map; min_repr=None; diseq = Disequalities.empty; bldis=BlDis.empty} + let init_cc = + {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = None; diseq = Disequalities.empty; bldis = BlDis.empty} (** closure of disequalities *) let congruence_neq cc neg = @@ -878,20 +875,6 @@ module CongruenceClosure = struct else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs - (** Throws Unsat if the congruence is unsatisfiable.*) - let init_congruence conj = - let cc = init_cc conj in - (* propagating equalities through derefs *) - closure (Some cc) conj - - (** Returns None if the congruence is unsatisfiable.*) - let init_congruence_opt conj = - let cc = init_cc conj in - (* propagating equalities through derefs *) - match closure (Some cc) conj with - | exception Unsat -> None - | x -> Some x - (** Add a term to the data structure. Returns (reference variable, offset), updated congruence closure *) @@ -1028,7 +1011,7 @@ module CongruenceClosure = struct (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) in let new_reps, new_cc, reachable_old_reps = - SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some(init_cc [])),[]) cc.set in + SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some init_cc),[]) cc.set in let cmap = Disequalities.comp_map cc.uf in (* breadth-first search of reachable states *) let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = @@ -1146,7 +1129,7 @@ module CongruenceClosure = struct | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs | Some (c, c1_off) -> pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in - let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some (init_cc []),[]) mappings in + let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some init_cc,[]) mappings in (* add equalities that make sure that all atoms that have the same representative are equal. *) let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = @@ -1183,7 +1166,7 @@ module CongruenceClosure = struct | None -> cc, Map.add new_element (new_term, a_off) pmap | Some (c, c1_off) -> add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in - List.fold_left add_term (Some (init_cc []), Map.empty) mappings + List.fold_left add_term (Some init_cc, Map.empty) mappings (** Here we do the join without using the automata, because apparently we don't want to describe the automaton in the paper... diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 1f9f92b052..c0c05eaf1a 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -516,9 +516,6 @@ module UnionFind = struct let empty = ValMap.empty - (** create empty union find map, given a list of elements *) - let init = List.fold_left (fun map v -> ValMap.add v ((v, Z.zero), 1) map) (ValMap.empty) - (** `parent uf v` returns (p, z) where p is the parent element of v in the union find tree and z is the offset. From d1f4f895cea13d161d4c12b25de194742635a4d5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 10:28:52 +0200 Subject: [PATCH 254/323] add some tracing --- src/cdomains/c2poDomain.ml | 48 +++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 6100d5d4a0..d4a501c66a 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -51,7 +51,9 @@ module D = struct if exactly_equal x y then true else - (T.props_equal (get_normal_form x) (get_normal_form y)) + let nf1, nf2 = get_normal_form x, get_normal_form y in + if M.tracing then M.trace "c2po-min-repr" "Normal form of x = %s; Normal form of y = %s" (show_conj nf1) (show_conj nf2); + T.props_equal nf1 nf2 | None, None -> true | _ -> false in if M.tracing then M.trace "c2po-equal" "equal min repr. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res @@ -136,30 +138,34 @@ module D = struct if GobConfig.get_bool "ana.c2po.precise_join" then join a b(*TODO*) else widen_eq_classes a b let meet a' b' = - match a',b' with - | None, _ -> None - | _, None -> None - | Some a, Some b -> - if exactly_equal a b then - a' - else - match get_conjunction a with - | [] -> b' - | a_conj -> remove_min_repr (meet_conjs_opt a_conj b') + if M.tracing then M.trace "c2po-meet" "MEET x= %s; y=%s" (show a') (show b'); + let res = match a',b' with + | None, _ -> None + | _, None -> None + | Some a, Some b -> + if exactly_equal a b then + a' + else + match get_conjunction a with + | [] -> b' + | a_conj -> remove_min_repr (meet_conjs_opt a_conj b') + in if M.tracing then M.trace "c2po-meet" "MEET RESULT = %s" (show res);res let leq x y = equal (meet x y) x let narrow a' b' = - match a',b' with - | None, _ -> None - | _, None -> None - | Some a, Some b -> - if exactly_equal a b then - a' - else - let b_conj = List.filter - (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_conjunction b) in - remove_min_repr (meet_conjs_opt b_conj (Some a)) + let res = match a',b' with + | None, _ -> None + | _, None -> None + | Some a, Some b -> + if exactly_equal a b then + a' + else + let b_conj = List.filter + (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_conjunction b) in + remove_min_repr (meet_conjs_opt b_conj (Some a)) + in if M.tracing then M.trace "c2po-meet" "NARROW RESULT = %s" (show res);res + let pretty_diff () (x,y) = Pretty.dprintf "" From 17f0954cb16eb3239719e94d8c2db41ef1600a26 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 10:29:06 +0200 Subject: [PATCH 255/323] fix bug when adding disequalities --- src/cdomains/congruenceClosure.ml | 206 +++++++++++++++--------------- 1 file changed, 103 insertions(+), 103 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 8c12af67da..97bdb50bf7 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -11,6 +11,96 @@ module CongruenceClosure = struct module TUF = UnionFind module LMap = LookupMap + + (* block disequalities *) + module BlDis = struct + (** Block disequalities: + a term t1 is mapped to a set of terms that have a different block than t1. + It is allowed to contain terms that are not present in the data structure, + so we shouldn't assume that all terms in bldis are present in the union find! + *) + type t = TSet.t TMap.t [@@deriving eq, ord, hash] + + let bindings = TMap.bindings + let empty = TMap.empty + let is_empty = TMap.is_empty + + let to_conj bldiseq = List.fold + (fun list (t1, tset) -> + TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list + ) [] (bindings bldiseq) + + let add bldiseq t1 t2 = + match TMap.find_opt t1 bldiseq with + | None -> TMap.add t1 (TSet.singleton t2) bldiseq + | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq + + (** Add disequalities bl(t1) != bl(t2) and bl(t2) != bl(t1). *) + let add_block_diseq bldiseq (t1, t2) = + add (add bldiseq t1 t2) t2 t1 + + (** + params: + + t1-> a term that is NOT present in the data structure + + tlist: a list of representative terms + + For each term t2 in tlist, it adds the disequality t1 != t2 to diseqs. + *) + let add_block_diseqs bldiseq uf t1 tlist = + List.fold (fun bldiseq t2 -> + add_block_diseq bldiseq (t1, t2)) bldiseq tlist + + (** For each block disequality bl(t1) != bl(t2) we add all disequalities + that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', + then we add the disequaity bl(t1') != bl(t2'). + *) + let element_closure bldis cmap = + let comp_closure = function + | BlNequal (r1,r2) -> + let to_list = (*TODO this is not the best solution*) + List.flatten % List.map + (fun (z, set) -> (TSet.to_list set)) in + let comp_closure_zmap bindings1 bindings2 = + List.cartesian_product (to_list bindings1) (to_list bindings2) + in + let singleton term = [(Z.zero, TSet.singleton term)] in + begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with + | None, None -> [(r1,r2)] + | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) + | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) + | Some zmap1, Some zmap2 -> + comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) + end + | _ -> [] + in + List.concat_map comp_closure bldis + + let map_set_mem v v' (map:t) = match TMap.find_opt v map with + | None -> false + | Some set -> TSet.mem v' set + + let filter_if (map:t) p = + TMap.filter_map (fun _ t_set -> + let filtered_set = TSet.filter p t_set in + if TSet.is_empty filtered_set then None else Some filtered_set) map + + let filter_map f (diseq:t) = + TMap.filter_map + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) diseq + + let shift v r v' (map:t) = + match TMap.find_opt v' map with + | None -> map + | Some tset -> + TMap.remove v' (TMap.add v tset map) + + let term_set bldis = + TSet.of_enum (TMap.keys bldis) + end + module Disequalities = struct (* disequality map: @@ -191,17 +281,17 @@ module CongruenceClosure = struct Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. *) - let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) = function (* v1, v2 are distinct roots with v1 != v2+r *) + let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) bldis = function (* v1, v2 are distinct roots with v1 != v2+r *) | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) | (v1,v2,r) :: rest -> (* we don't want to explicitly store disequalities of the kind &x != &y *) - if T.is_addr v1 && T.is_addr v2 then - propagate_neq (uf,cmap,arg,neq) rest else + if T.is_addr v1 && T.is_addr v2 || BlDis.map_set_mem v1 v2 bldis then + propagate_neq (uf,cmap,arg,neq) bldis rest else (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) - if T.equal v1 v2 then (* should not happen *) - if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) rest + if T.equal v1 v2 then + if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) bldis rest else (* check whether it is already in neq *) - if map_set_mem (v1,Z.(-r)) v2 neq then propagate_neq (uf,cmap,arg,neq) rest + if map_set_mem (v1,Z.(-r)) v2 neq then propagate_neq (uf,cmap,arg,neq) bldis rest else let neq = map_set_add (v1,Z.(-r)) v2 neq |> map_set_add (v2,r) v1 in (* @@ -209,7 +299,7 @@ module CongruenceClosure = struct at the same level (not recorded) and then compare their predecessors *) match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with - | None,_ | _,None -> (*should not happen*) propagate_neq (uf,cmap,arg,neq) rest + | None,_ | _,None -> (*should not happen*) propagate_neq (uf,cmap,arg,neq) bldis rest | Some imap1, Some imap2 -> let ilist1 = ZMap.bindings imap1 in let rest = List.fold_left (fun rest (r1,_) -> @@ -228,7 +318,7 @@ module CongruenceClosure = struct else (v1',v2',Z.(r'2-r'1))::rest ) rest l1 l2) rest ilist1 in - propagate_neq (uf,cmap,arg,neq) rest + propagate_neq (uf,cmap,arg,neq) bldis rest (* collection of disequalities: * disequalities originating from different offsets of same root @@ -304,95 +394,6 @@ module CongruenceClosure = struct List.concat_map comp_closure diseqs end - (* block disequalities *) - module BlDis = struct - (** Block disequalities: - a term t1 is mapped to a set of terms that have a different block than t1. - It is allowed to contain terms that are not present in the data structure, - so we shouldn't assume that all terms in bldis are present in the union find! - *) - type t = TSet.t TMap.t [@@deriving eq, ord, hash] - - let bindings = TMap.bindings - let empty = TMap.empty - let is_empty = TMap.is_empty - - let to_conj bldiseq = List.fold - (fun list (t1, tset) -> - TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list - ) [] (bindings bldiseq) - - let add bldiseq t1 t2 = - match TMap.find_opt t1 bldiseq with - | None -> TMap.add t1 (TSet.singleton t2) bldiseq - | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq - - (** Add disequalities bl(t1) != bl(t2) and bl(t2) != bl(t1). *) - let add_block_diseq bldiseq (t1, t2) = - add (add bldiseq t1 t2) t2 t1 - - (** - params: - - t1-> a term that is NOT present in the data structure - - tlist: a list of representative terms - - For each term t2 in tlist, it adds the disequality t1 != t2 to diseqs. - *) - let add_block_diseqs bldiseq uf t1 tlist = - List.fold (fun bldiseq t2 -> - add_block_diseq bldiseq (t1, t2)) bldiseq tlist - - (** For each block disequality bl(t1) != bl(t2) we add all disequalities - that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', - then we add the disequaity bl(t1') != bl(t2'). - *) - let element_closure bldis cmap = - let comp_closure = function - | BlNequal (r1,r2) -> - let to_list = (*TODO this is not the best solution*) - List.flatten % List.map - (fun (z, set) -> (TSet.to_list set)) in - let comp_closure_zmap bindings1 bindings2 = - List.cartesian_product (to_list bindings1) (to_list bindings2) - in - let singleton term = [(Z.zero, TSet.singleton term)] in - begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with - | None, None -> [(r1,r2)] - | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) - | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) - | Some zmap1, Some zmap2 -> - comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) - end - | _ -> [] - in - List.concat_map comp_closure bldis - - let map_set_mem v v' (map:t) = match TMap.find_opt v map with - | None -> false - | Some set -> TSet.mem v' set - - let filter_if (map:t) p = - TMap.filter_map (fun _ t_set -> - let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) map - - let filter_map f (diseq:t) = - TMap.filter_map - (fun _ s -> let set = TSet.filter_map f s in - if TSet.is_empty set then None else Some set) diseq - - let shift v r v' (map:t) = - match TMap.find_opt v' map with - | None -> map - | Some tset -> - TMap.remove v' (TMap.add v tset map) - - let term_set bldis = - TSet.of_enum (TMap.keys bldis) - end - (** Set of subterms which are present in the current data structure. TODO: check if it is needed? Because this information is implicitly present in the union find data structure. *) module SSet = struct @@ -747,11 +748,11 @@ module CongruenceClosure = struct (* getting args of dereferences *) let uf,cmap,arg = Disequalities.get_args cc.uf in (* taking implicit dis-equalities into account *) - let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap,arg) in - let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) neq_list in + let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap, arg) in + let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) cc.bldis neq_list in (* taking explicit dis-equalities into account *) let neq_list = Disequalities.init_list_neq uf neg in - let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) neq_list in + let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) cc.bldis neq_list in if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=cc.bldis} with Unsat -> None @@ -968,10 +969,9 @@ module CongruenceClosure = struct let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs, bl_conjs = split conjs in let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in - match insert_set (meet_conjs cc pos_conjs) terms_to_add with + match add_normalized_bl_diseqs (insert_set (meet_conjs cc pos_conjs) terms_to_add) bl_conjs with | exception Unsat -> None - | Some cc -> let cc = congruence_neq cc neg_conjs in - add_normalized_bl_diseqs cc bl_conjs + | Some cc -> congruence_neq cc neg_conjs | None -> None (** Add proposition t1 = t2 + r to the data structure. *) From 35f4b05c419e8f071fba1bbbe9b5a6590ad6f1c4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 12:37:40 +0200 Subject: [PATCH 256/323] fix join; less code duplication --- src/cdomains/c2poDomain.ml | 32 ++++++-------------------------- 1 file changed, 6 insertions(+), 26 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index d4a501c66a..915f192699 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -71,27 +71,7 @@ module D = struct | Some cc -> TUF.is_empty cc.uf && Disequalities.is_empty cc.diseq && BlDis.is_empty cc.bldis - let join_automaton a b = - let res = - match a,b with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if exactly_equal a b then - Some a - else - (if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) - in - if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" - (show_all res); - res - - let join_eq_classes a' b' = + let join a' b' join_cc_function = let res = match a',b' with | None, b -> b @@ -100,19 +80,19 @@ module D = struct if exactly_equal a b then a' else - (if M.tracing then M.tracel "c2po-join" "JOIN EQ CLASSES. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_eq_no_automata a b) in + let cc = fst(join_cc_function a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) + in let cc = join_bldis a.bldis b.bldis a b cc cmap1 cmap2 in + join_neq a.diseq b.diseq a b (Some cc) cmap1 cmap2) in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); res let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then - (if M.tracing then M.trace "c2po-join" "Join Automaton"; join_automaton a b) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_eq_classes a b) + (if M.tracing then M.trace "c2po-join" "Join Automaton"; join a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join a b join_eq_no_automata) let widen_eq_classes a' b' = let res = From d10a49fbdcae359eee71b2ea3611e35e564cd4c3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 13:00:55 +0200 Subject: [PATCH 257/323] always first update block disequalities and then normal disequalities --- src/cdomains/congruenceClosure.ml | 33 +++++++++++++++++-------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 97bdb50bf7..cc7b0aa86e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -757,6 +757,10 @@ module CongruenceClosure = struct Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=cc.bldis} with Unsat -> None + let congruence_neq_opt cc neq = match cc with + | None -> None + | Some cc -> congruence_neq cc neq + (** parameters: (uf, map, new_repr) equalities. @@ -851,6 +855,8 @@ module CongruenceClosure = struct - `bldis` are the block disequalities between the new representatives. Throws "Unsat" if a contradiction is found. + This does NOT update the disequalities. + They need to be updated with `congruence_neq`. *) let closure cc conjs = match cc with @@ -858,7 +864,7 @@ module CongruenceClosure = struct | Some cc -> let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in let bldis = update_bldis new_repr cc.bldis in - congruence_neq {uf; set = cc.set; map; min_repr=cc.min_repr; diseq=cc.diseq; bldis=bldis} [] + Some {uf; set = cc.set; map; min_repr=cc.min_repr; diseq=cc.diseq; bldis=bldis} (** Adds the block disequalities to the cc, but first rewrites them such that they are disequalities between representatives. The cc should already contain @@ -907,7 +913,8 @@ module CongruenceClosure = struct let insert cc t = match cc with | None -> (t, Z.zero), None - | Some cc -> insert cc t + | Some cc -> let (r, z), cc = insert cc t in + (r, z), congruence_neq_opt cc [] (** Add all terms in a specific set to the data structure. @@ -958,8 +965,9 @@ module CongruenceClosure = struct Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq (** Adds equalities to the data structure. - Throws "Unsat" if a contradiction is found. *) - let meet_conjs cc pos_conjs = + Throws "Unsat" if a contradiction is found. + Does not update disequalities. *) + let meet_pos_conjs cc pos_conjs = let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in closure cc pos_conjs in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_conjunction res)) "None" res);res @@ -969,12 +977,13 @@ module CongruenceClosure = struct let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs, bl_conjs = split conjs in let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in - match add_normalized_bl_diseqs (insert_set (meet_conjs cc pos_conjs) terms_to_add) bl_conjs with + match add_normalized_bl_diseqs (insert_set (meet_pos_conjs cc pos_conjs) terms_to_add) bl_conjs with | exception Unsat -> None | Some cc -> congruence_neq cc neg_conjs | None -> None - (** Add proposition t1 = t2 + r to the data structure. *) + (** Add proposition t1 = t2 + r to the data structure. + Does not update the disequalities. *) let add_eq cc (t1, t2, r) = let (v1, r1), cc = insert cc t1 in let (v2, r2), cc = insert cc t2 in @@ -1100,16 +1109,10 @@ module CongruenceClosure = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = let old_cc = cc in - match remove_terms_from_eq predicate cc with + match remove_terms_from_eq predicate {cc with min_repr=None} with | new_reps, Some cc -> - begin match remove_terms_from_diseq old_cc.diseq new_reps cc with - | Some cc -> - let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - if M.tracing then M.trace "c2po" "REMOVE TERMS:\n BEFORE: %s\nRESULT: %s\n" - (show_all old_cc) (show_all {uf=cc.uf; set = cc.set; map = cc.map; min_repr=cc.min_repr; diseq=cc.diseq; bldis}); - Some {uf=cc.uf; set = cc.set; map = cc.map; min_repr=None; diseq=cc.diseq; bldis} - | None -> None - end + let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in + remove_terms_from_diseq old_cc.diseq new_reps {cc with bldis} | _,None -> None (* join version 1: by using the automaton *) From c3479f4d58a4dbb901dbb992fd7c1d646d9d8cec Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 14:27:01 +0200 Subject: [PATCH 258/323] remove some TODOs --- src/analyses/c2poAnalysis.ml | 8 +++++--- src/cdomains/unionFind.ml | 3 ++- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 9f753fc739..c5793c1b94 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -94,7 +94,7 @@ struct | _ -> Result.top q let assign_lval t ask lval expr = - (* ignore assignments to values that are not 64 bits *) (*TODO what if there is a cast*) + (* ignore assignments to values that are not 64 bits *) let lval_t = typeOfLval lval in match T.get_element_size_in_bits lval_t, T.of_lval ask lval, T.of_cil ask expr with (* Indefinite assignment *) @@ -107,11 +107,13 @@ struct D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo lval_t - | exception (T.UnsupportedCilExpression _) -> D.top () (*TODO count how many we have here*) + | exception (T.UnsupportedCilExpression _) -> if M.tracing then M.trace + "c2po-invalidate" "INVALIDATE lval: %a" d_lval lval; + D.top () (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. We have to forget all the information we had. This should almost never happen. - Except if the left hand side is an abstract type, then we don't know the size of the lvalue. *) + Except if the left hand side is a complicated expression like myStruct.field1[i]->field2[z+k], and Goblint can't infer the offset.*) | _ -> D.top () let assign ctx lval expr = diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index c0c05eaf1a..394d34a3ba 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -220,7 +220,8 @@ module T = struct match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i | None - | exception (SizeOfError _) -> raise (UnsupportedCilExpression "unknown offset") + | exception (SizeOfError _) -> if M.tracing then M.trace "c2po-invalidate" "REASON: unknown offset"; + raise (UnsupportedCilExpression "unknown offset") let can_be_dereferenced = function | TPtr _| TArray _| TComp _ -> true From 28ba650036b0009fbea4e93d234c34c06a189008 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 15:35:24 +0200 Subject: [PATCH 259/323] make code for element_closure a bit better --- src/cdomains/c2poDomain.ml | 8 ++-- src/cdomains/congruenceClosure.ml | 69 +++++++++++-------------------- 2 files changed, 29 insertions(+), 48 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 915f192699..9c210677cf 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -84,8 +84,8 @@ module D = struct (show_all (Some a)) (show_all (Some b)); let cc = fst(join_cc_function a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_bldis a.bldis b.bldis a b cc cmap1 cmap2 in - join_neq a.diseq b.diseq a b (Some cc) cmap1 cmap2) + in let cc = Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc in + Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2)) in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); @@ -107,8 +107,8 @@ module D = struct (show_all (Some a)) (show_all (Some b)); let cc = fst(widen_eq_no_automata a b) in let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf - in let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 in - Some (join_bldis a.bldis b.bldis a b cc cmap1 cmap2)) + in let cc = Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2) in + Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc) in if M.tracing then M.tracel "c2po-join" "WIDEN. WIDEN: %s\n" (show_all res); diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index cc7b0aa86e..0c44d7208f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -52,27 +52,25 @@ module CongruenceClosure = struct List.fold (fun bldiseq t2 -> add_block_diseq bldiseq (t1, t2)) bldiseq tlist + (** Find all elements that are in the same equivalence class as t, + given the cmap, but only those that are now representatives in the union find uf. *) + let comp_t_cmap_repr cmap t uf = + match TMap.find_opt t cmap with + | None -> [Z.zero, t] + | Some zmap -> + List.flatten @@ List.map + (fun (z, set) -> + List.cartesian_product [z] (TSet.to_list (*TSet.filter (TUF.is_root uf*) set)) (ZMap.bindings zmap) + (** For each block disequality bl(t1) != bl(t2) we add all disequalities that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', then we add the disequaity bl(t1') != bl(t2'). *) - let element_closure bldis cmap = + let element_closure bldis cmap uf = let comp_closure = function | BlNequal (r1,r2) -> - let to_list = (*TODO this is not the best solution*) - List.flatten % List.map - (fun (z, set) -> (TSet.to_list set)) in - let comp_closure_zmap bindings1 bindings2 = - List.cartesian_product (to_list bindings1) (to_list bindings2) - in - let singleton term = [(Z.zero, TSet.singleton term)] in - begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with - | None, None -> [(r1,r2)] - | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) - | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) - | Some zmap1, Some zmap2 -> - comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) - end + let eq_class1, eq_class2 = comp_t_cmap_repr cmap r1 uf, comp_t_cmap_repr cmap r2 uf in + List.cartesian_product (List.map snd eq_class1) (List.map snd eq_class2) | _ -> [] in List.concat_map comp_closure bldis @@ -170,10 +168,6 @@ module CongruenceClosure = struct ) [] (TMap.bindings uf) - let flatten_map = - ZMap.map (fun zmap -> List.fold_left - (fun set (_,mapped) -> TSet.union set mapped) TSet.empty (ZMap.bindings zmap)) - (** arg: maps each representative term t to a map that maps an integer Z to @@ -372,30 +366,17 @@ module CongruenceClosure = struct that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', then we add the disequaity t1' != z + z2 - z1 + t2'. *) - let element_closure diseqs cmap = + let element_closure diseqs cmap uf = let comp_closure (r1,r2,z) = - let to_tuple_list = (*TODO this is not the best solution*) - List.flatten % List.map - (fun (z, set) -> List.cartesian_product [z] (TSet.to_list set)) in - let comp_closure_zmap bindings1 bindings2 = - List.map (fun ((z1, nt1),(z2, nt2)) -> - (nt1, nt2, Z.(-z2+z+z1))) - (List.cartesian_product (to_tuple_list bindings1) (to_tuple_list bindings2)) - in - let singleton term = [Z.zero, TSet.singleton term] in - begin match TMap.find_opt r1 cmap,TMap.find_opt r2 cmap with - | None, None -> [(r1,r2,z)] - | None, Some zmap2 -> comp_closure_zmap (singleton r1) (ZMap.bindings zmap2) - | Some zmap1, None -> comp_closure_zmap (ZMap.bindings zmap1) (singleton r2) - | Some zmap1, Some zmap2 -> - comp_closure_zmap (ZMap.bindings zmap1) (ZMap.bindings zmap2) - end + let eq_class1, eq_class2 = BlDis.comp_t_cmap_repr cmap r1 uf, BlDis.comp_t_cmap_repr cmap r2 uf in + List.map (fun ((z1, nt1),(z2, nt2)) -> + (nt1, nt2, Z.(-z2+z+z1))) + (List.cartesian_product eq_class1 eq_class2) in List.concat_map comp_closure diseqs end - (** Set of subterms which are present in the current data structure. - TODO: check if it is needed? Because this information is implicitly present in the union find data structure. *) + (** Set of subterms which are present in the current data structure. *) module SSet = struct type t = TSet.t [@@deriving eq, ord, hash] @@ -1193,9 +1174,9 @@ module CongruenceClosure = struct let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1) in - let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2) in - let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in + let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1 cc.uf) in + let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2 cc.uf) in + let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in let res = congruence_neq cc (diseq1 @ diseq2) in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res @@ -1207,9 +1188,9 @@ module CongruenceClosure = struct let bldiseq2 = BlDis.to_conj bldiseq2 in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1) in - let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2) in - let cc = Option.get (insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in + let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1 cc.uf) in + let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2 cc.uf) in + let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); From 79dacf2658a00c74a0553f353b1b90f008ae102d Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 16:16:18 +0200 Subject: [PATCH 260/323] simplify removal of block disequalities --- src/cdomains/congruenceClosure.ml | 44 +++++++++++++++---------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 0c44d7208f..7e5c032e4f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -97,6 +97,22 @@ module CongruenceClosure = struct let term_set bldis = TSet.of_enum (TMap.keys bldis) + + let map_lhs = + let add_change bldis (t1,t2) = + match TMap.find_opt t1 bldis with + | None -> bldis + | Some tset -> TMap.add t2 tset (TMap.remove t1 bldis) in + List.fold add_change + + let filter_map_lhs f (diseq:t) = + Enum.fold + (fun diseq t -> match f t with + | None -> TMap.remove t diseq + | Some t2 -> + if not (T.equal t t2) + then TMap.add t2 (TMap.find t diseq) (TMap.remove t diseq) else + diseq) diseq (TMap.keys diseq) end module Disequalities = struct @@ -807,18 +823,10 @@ module CongruenceClosure = struct (** Update block disequalities with the new representatives, *) let update_bldis new_repr bldis = + let bldis = BlDis.map_lhs bldis (TMap.bindings new_repr) in (* update block disequalities with the new representatives *) - let find_new_root t1 = match TMap.find_opt t1 new_repr with - | None -> t1 - | Some v -> v - in - let disequalities = BlDis.to_conj bldis - in (*TODO maybe optimize?, and maybe use this also for removing terms *) - let add_bl_dis new_diseq = function - | BlNequal (t1,t2) -> BlDis.add_block_diseq new_diseq (find_new_root t1,find_new_root t2) - | _-> new_diseq - in - List.fold add_bl_dis BlDis.empty disequalities + let find_new_root t1 = Option.default t1 (TMap.find_opt t1 new_repr) in + BlDis.filter_map (fun t1 -> Some (find_new_root t1)) bldis (** Parameters: cc conjunctions. @@ -1073,17 +1081,9 @@ module CongruenceClosure = struct in congruence_neq cc new_diseq let remove_terms_from_bldis bldis new_reps cc = - let disequalities = BlDis.to_conj bldis - in - let add_bl_dis new_diseq = function - | BlNequal (t1,t2) -> - begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with - | Some (t1',z1'), Some (t2', z2') -> BlDis.add_block_diseq new_diseq (t1', t2') - | _ -> new_diseq - end - | _-> new_diseq - in - List.fold add_bl_dis BlDis.empty disequalities + let find_new_root_term t = Option.map fst (find_new_root new_reps cc.uf t) in + let bldis = BlDis.filter_map_lhs find_new_root_term bldis in + BlDis.filter_map find_new_root_term bldis (** Remove terms from the data structure. It removes all terms for which "predicate" is false, From b2b75a244e2d4cda0d4b5d4fc8e1698d9ebb09c1 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 16:26:35 +0200 Subject: [PATCH 261/323] maybe fixed combine_env? --- src/analyses/c2poAnalysis.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index c5793c1b94..0b935bb1fb 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -196,11 +196,7 @@ struct (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) - let combine_env ctx var_opt expr f exprs t_context_opt t (ask: Queries.ask) = - ctx.local - - (*ctx.local is after combine_env, t callee*) - let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = + let combine_env ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = let og_t = t in (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in @@ -213,7 +209,11 @@ struct if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; let local = D.remove_tainted_terms ask tainted state_with_assignments in let t = D.meet local t in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t); + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t + + (*ctx.local is after combine_env, t callee*) + let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = + let t = ctx.local in let t = match var_opt with | None -> t | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) From b95e2c69df1b56f0e4e3fd843e456bd0ae42b44a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 17 Jul 2024 16:43:33 +0200 Subject: [PATCH 262/323] optimize minimal representatives --- src/analyses/c2poAnalysis.ml | 4 ++-- src/cdomains/c2poDomain.ml | 12 ++++++------ src/cdomains/congruenceClosure.ml | 23 ++++++++++++----------- 3 files changed, 20 insertions(+), 19 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 0b935bb1fb..bd50dc1f87 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -123,7 +123,7 @@ struct let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in - let res = remove_min_repr (meet_conjs_opt valid_props ctx.local) in + let res = recompute_min_repr (meet_conjs_opt valid_props ctx.local) in if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s; is_bot: %b\n" d_exp e pos (show_conj valid_props) (D.is_bot res); if D.is_bot res then raise Deadcode; @@ -134,7 +134,7 @@ struct let assign_return ask t return_var expr = (* the return value is not stored on the heap, therefore we don't need to remove any terms *) match T.of_cil ask expr with - | (Some term, Some offset) -> remove_min_repr (meet_conjs_opt [Equal (return_var, term, offset)] t) + | (Some term, Some offset) -> recompute_min_repr (meet_conjs_opt [Equal (return_var, term, offset)] t) | _ -> t let return ctx exp_opt f = diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 9c210677cf..29648ed266 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -89,7 +89,7 @@ module D = struct in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); - res + Option.map compute_min_repr_if_necessary res let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then (if M.tracing then M.trace "c2po-join" "Join Automaton"; join a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join a b join_eq_no_automata) @@ -112,7 +112,7 @@ module D = struct in if M.tracing then M.tracel "c2po-join" "WIDEN. WIDEN: %s\n" (show_all res); - res + Option.map compute_min_repr_if_necessary res let widen a b = if M.tracing then M.trace "c2po-join" "WIDEN\n"; if GobConfig.get_bool "ana.c2po.precise_join" then join a b(*TODO*) else widen_eq_classes a b @@ -128,8 +128,9 @@ module D = struct else match get_conjunction a with | [] -> b' - | a_conj -> remove_min_repr (meet_conjs_opt a_conj b') - in if M.tracing then M.trace "c2po-meet" "MEET RESULT = %s" (show res);res + | a_conj -> recompute_min_repr (meet_conjs_opt a_conj b') + in if M.tracing then M.trace "c2po-meet" "MEET RESULT = %s" (show res); + res let leq x y = equal (meet x y) x @@ -143,10 +144,9 @@ module D = struct else let b_conj = List.filter (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_conjunction b) in - remove_min_repr (meet_conjs_opt b_conj (Some a)) + recompute_min_repr (meet_conjs_opt b_conj (Some a)) in if M.tracing then M.trace "c2po-meet" "NARROW RESULT = %s" (show res);res - let pretty_diff () (x,y) = Pretty.dprintf "" let printXml f x = match x with diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7e5c032e4f..3aafd1063f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -592,17 +592,17 @@ module CongruenceClosure = struct (edge_z, t, TUF.find_no_pc uf res_t)) @@ (LMap.zmap_bindings zmap))) (LMap.bindings map) - let compute_min_repr_if_necessary cc = - match cc.min_repr with - | None -> let min_repr, uf = - MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in - {cc with min_repr = Some min_repr; uf}, min_repr - | Some min_repr -> cc, min_repr + if GobConfig.get_bool "ana.c2po.normal_form" then + match cc.min_repr with + | None -> let min_repr, uf = + MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in + {cc with min_repr = Some min_repr; uf} + | Some min_repr -> cc + else cc - let remove_min_repr = function - | None -> None - | Some cc -> Some {cc with min_repr=None} + let recompute_min_repr = + Option.map (fun cc -> compute_min_repr_if_necessary {cc with min_repr=None}) let exactly_equal cc1 cc2 = cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis @@ -611,7 +611,7 @@ module CongruenceClosure = struct Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = - let cc, min_repr = compute_min_repr_if_necessary cc in + let min_repr = Option.get cc.min_repr in let normalize_equality (t1, t2, z) = if T.equal t1 t2 && Z.(equal z zero) then None else Some (Equal (t1, t2, z)) in @@ -1093,7 +1093,8 @@ module CongruenceClosure = struct match remove_terms_from_eq predicate {cc with min_repr=None} with | new_reps, Some cc -> let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - remove_terms_from_diseq old_cc.diseq new_reps {cc with bldis} + let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with bldis} in + Option.map compute_min_repr_if_necessary cc | _,None -> None (* join version 1: by using the automaton *) From 44668a49ba7b4d91aecc1e4124f0f62c307c6315 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 18 Jul 2024 11:36:50 +0200 Subject: [PATCH 263/323] less code duplication for get_normal_form --- src/cdomains/congruenceClosure.ml | 75 ++++++++----------------------- 1 file changed, 19 insertions(+), 56 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 3aafd1063f..f441fb5555 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -64,7 +64,8 @@ module CongruenceClosure = struct (** For each block disequality bl(t1) != bl(t2) we add all disequalities that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', - then we add the disequaity bl(t1') != bl(t2'). + then we add the disequaity bl(t1') != bl(t2'), + but only for t1' and t2' which are roots in uf. *) let element_closure bldis cmap uf = let comp_closure = function @@ -607,11 +608,7 @@ module CongruenceClosure = struct let exactly_equal cc1 cc2 = cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis - (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) - Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) - (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) - let get_normal_form cc = - let min_repr = Option.get cc.min_repr in + let get_normal_conjunction cc get_normal_repr = let normalize_equality (t1, t2, z) = if T.equal t1 t2 && Z.(equal z zero) then None else Some (Equal (t1, t2, z)) in @@ -619,42 +616,34 @@ module CongruenceClosure = struct let atoms = SSet.get_atoms cc.set in List.filter_map (fun atom -> let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in - let (min_state, min_z) = MRMap.find rep_state min_repr in + let (min_state, min_z) = get_normal_repr rep_state in normalize_equality (atom, min_state, Z.(rep_z - min_z)) ) atoms in let conjunctions_of_transitions = let transitions = get_transitions (cc.uf, cc.map) in List.filter_map (fun (z,s,(s',z')) -> - let (min_state, min_z) = MRMap.find s min_repr in - let (min_state', min_z') = MRMap.find s' min_repr in + let (min_state, min_z) = get_normal_repr s in + let (min_state', min_z') = get_normal_repr s' in normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) ) transitions in (*disequalities*) let disequalities = Disequalities.get_disequalities cc.diseq in (* find disequalities between min_repr *) let normalize_disequality (t1, t2, z) = - let (min_state1, min_z1) = MRMap.find t1 min_repr in - let (min_state2, min_z2) = MRMap.find t2 min_repr in + let (min_state1, min_z1) = get_normal_repr t1 in + let (min_state2, min_z2) = get_normal_repr t2 in let new_offset = Z.(-min_z2 + min_z1 + z) in if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) else Nequal (min_state2, min_state1, Z.(-new_offset)) in - if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMin repr: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (MRMap.show_min_rep min_repr) (LMap.show_map cc.map); + if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in (* block disequalities *) let normalize_bldis t = match t with | BlNequal (t1,t2) -> - let min_state1 = - begin match MRMap.find_opt t1 min_repr with - | None -> t1 - | Some (a,_) -> a - end in - let min_state2 = - begin match MRMap.find_opt t2 min_repr with - | None -> t2 - | Some (a,_) -> a - end in + let min_state1, _ = get_normal_repr t1 in + let min_state2, _ = get_normal_repr t2 in if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) else BlNequal (min_state2, min_state1) | _ -> t @@ -663,44 +652,18 @@ module CongruenceClosure = struct (* all propositions *) BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) + Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) + (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) + let get_normal_form cc = + let min_repr = Option.get cc.min_repr in + get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) (** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) let get_conjunction cc = - let normalize_equality (t1, t2, z) = - if T.equal t1 t2 && Z.(equal z zero) then None else - Some (Equal (t1, t2, z)) in - let conjunctions_of_atoms = - let atoms = SSet.get_atoms cc.set in - List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in - normalize_equality (atom, rep_state, rep_z) - ) atoms - in - let conjunctions_of_transitions = - let transitions = get_transitions (cc.uf, cc.map) in - List.filter_map (fun (z,s,(s',z')) -> - normalize_equality (SSet.deref_term_even_if_its_not_possible s z cc.set, s', z') - ) transitions in - (*disequalities*) - let disequalities = Disequalities.get_disequalities cc.diseq in - (* find disequalities between min_repr *) - let normalize_disequality (t1, t2, z) = - if T.compare t1 t2 < 0 then Nequal (t1, t2, z) - else Nequal (t2, t1, Z.(-z)) - in - if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); - let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in - (* block disequalities *) - let normalize_bldis t = match t with - | BlNequal (t1,t2) -> - if T.compare t1 t2 < 0 then BlNequal (t1, t2) - else BlNequal (t2, t1) - | _ -> t - in - let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in - (* all propositions *) - BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) + get_normal_conjunction cc (fun t -> t,Z.zero) let show_all x = "Normal form:\n" ^ show_conj((get_conjunction x)) ^ From 5f2b938c0501008a95476ebdb7d704db654f41a0 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 18 Jul 2024 11:51:05 +0200 Subject: [PATCH 264/323] simplify insertion a bit --- src/cdomains/congruenceClosure.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index f441fb5555..bd4ec2e316 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -845,7 +845,7 @@ module CongruenceClosure = struct match t with | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let set = SSet.add t cc.set in - (t, Z.zero), Some {cc with uf; set;} + (t, Z.zero), Some {cc with uf; set} | Deref (t', z, exp) -> match insert cc t' with | (v, r), None -> (v, r), None @@ -854,10 +854,10 @@ module CongruenceClosure = struct match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {uf; set; map = LMap.map_add (v, Z.(r + z)) t cc.map;min_repr=cc.min_repr; diseq = cc.diseq; bldis=cc.bldis}) [(t, v', Z.zero)] + (v2,z2), closure (Some {cc with uf; set}) [(t, v', Z.zero)] | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {uf; set; map; min_repr=cc.min_repr; diseq = cc.diseq; bldis=cc.bldis} + (t, Z.zero), Some {cc with uf; set; map} (** Add a term to the data structure. From 2af0179ec5c5d19221f9677b2d66b71ab3944c9f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 18 Jul 2024 15:07:41 +0200 Subject: [PATCH 265/323] add calloc and alloca and realloc to special --- src/analyses/c2poAnalysis.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index bd50dc1f87..c1693ff706 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -163,13 +163,13 @@ struct ctx.local else branch ctx exp true - | Malloc exp -> (*exp is the size of the malloc'ed block*) + | Malloc _ | Calloc _ | Alloca _ | Realloc _ -> begin match var_opt with | None -> ctx.local | Some varin -> if M.tracing then M.trace "c2po-malloc" - "SPECIAL MALLOC: exp = %a; var_opt = Some (%a); v = %a; " d_exp exp d_lval varin d_lval (Var v, NoOffset); + "SPECIAL MALLOC: var_opt = Some (%a); v = %a; " d_lval varin d_lval (Var v, NoOffset); add_new_block ctx.local (ask_of_ctx ctx) varin end | _ -> ctx.local From fbe1310f1b33a204bf4ee95cfc140f1743ac333f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 18 Jul 2024 15:38:20 +0200 Subject: [PATCH 266/323] removed unused things --- src/analyses/c2poAnalysis.ml | 30 ------------------------------ src/cdomains/congruenceClosure.ml | 1 - src/cdomains/unionFind.ml | 5 ----- 3 files changed, 36 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index c1693ff706..6375db9692 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -37,35 +37,6 @@ struct in if M.tracing then M.trace "c2po" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res - (* let query_may_point_to ctx t e = - if M.tracing then M.trace "c2po-query" "may-point-to %a!" - d_exp e; - match T.of_cil (ask_of_ctx ctx) e with - | Some term, Some offset -> - begin match insert t term with - | _,None -> MayBeEqual.AD.top() - | _,Some cc -> - let res = let comp = Disequalities.comp_t cc.uf term in - let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in - let equal_terms = List.filter valid_term comp in - if M.tracing then M.trace "c2po-query" "may-point-to %a -> equal terms: %s" - d_exp e (List.fold (fun s (t,z) -> s ^ "(" ^ T.show t ^","^ Z.to_string Z.(z + offset) ^")") "" equal_terms); - let intersect_query_result res (term,z) = - let next_query = - let ctx = {ctx with local=Some (init_cc [])} in - match MayBeEqual.ask_may_point_to (ask_of_ctx ctx) (T.to_cil_sum Z.(z + offset) (T.to_cil term)) with - | exception (T.UnsupportedCilExpression _) -> MayBeEqual.AD.top() - | res -> if MayBeEqual.AD.is_bot res then MayBeEqual.AD.top() else res - in - MayBeEqual.AD.meet res next_query in - List.fold intersect_query_result (MayBeEqual.AD.top()) equal_terms - in if M.tracing then M.trace "c2po-query" "may-point-to %a : %a. Is bot: %b\n" - d_exp e MayBeEqual.AD.pretty res (MayBeEqual.AD.is_bot res); res - end - | _ -> - MayBeEqual.AD.top() *) - let conj_to_invariant ask conjs t = List.fold (fun a prop -> let exp = T.prop_to_cil prop in if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; @@ -90,7 +61,6 @@ struct | Some t -> (conj_to_invariant (ask_of_ctx ctx) (get_conjunction t) (Some t)) end - (* | MayPointTo e -> query_may_point_to ctx ctx.local e *) | _ -> Result.top q let assign_lval t ask lval expr = diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index bd4ec2e316..bbf321bdc1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -891,7 +891,6 @@ module CongruenceClosure = struct else (false,cc) let block_neq_query cc (t1,t2) = - (* we implicitly assume that &x != &y + z *) let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in match cc with diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 394d34a3ba..e85643662e 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -486,11 +486,6 @@ module T = struct in BinOp (op, to_cil t1, to_cil_sum z (to_cil t2), TInt (IBool,[])) - let conj_to_invariant conjs = - List.fold (fun a prop -> let exp = prop_to_cil prop in - if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; - Invariant.(a && of_exp exp)) (Invariant.top()) conjs - end module TMap = struct From 6a35b053b82c88bfc9599b9cc1058a9619a3431b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 18 Jul 2024 15:38:55 +0200 Subject: [PATCH 267/323] forget var information in special --- src/analyses/c2poAnalysis.ml | 45 ++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 6375db9692..41d6995735 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -93,7 +93,10 @@ struct let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in - let res = recompute_min_repr (meet_conjs_opt valid_props ctx.local) in + let res = + if List.is_empty valid_props then ctx.local else + recompute_min_repr (meet_conjs_opt valid_props ctx.local) + in if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s; is_bot: %b\n" d_exp e pos (show_conj valid_props) (D.is_bot res); if D.is_bot res then raise Deadcode; @@ -114,35 +117,33 @@ struct | None -> ctx.local in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res - let add_new_block t ask lval = - (* ignore assignments to values that are not 64 bits *) - let lval_t = typeOfLval lval in - match T.get_element_size_in_bits lval_t, T.of_lval ask lval with - (* Indefinite assignment *) - | s, lterm -> - let t = D.remove_may_equal_terms ask s lterm t in - add_block_diseqs t lterm - (* Definite assignment *) - | exception (T.UnsupportedCilExpression _) -> D.top () - (** var_opt is the variable we assign to. It has type lval. v=malloc.*) let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in + let ask = ask_of_ctx ctx in + let t = begin match var_opt with + | None -> + ctx.local + | Some varin -> + (* forget information about var, + but ignore assignments to values that are not 64 bits *) + try + (let s, lterm = T.get_element_size_in_bits (typeOfLval varin), T.of_lval ask varin in + let t = D.remove_may_equal_terms ask s lterm ctx.local in + begin match desc.special exprs with + | Malloc _ | Calloc _ | Alloca _ | Realloc _ -> + add_block_diseqs t lterm + | _ -> t + end) + with (T.UnsupportedCilExpression _) -> D.top () + end + in match desc.special exprs with | Assert { exp; refine; _ } -> if not refine then ctx.local else branch ctx exp true - | Malloc _ | Calloc _ | Alloca _ | Realloc _ -> - begin match var_opt with - | None -> - ctx.local - | Some varin -> - if M.tracing then M.trace "c2po-malloc" - "SPECIAL MALLOC: var_opt = Some (%a); v = %a; " d_lval varin d_lval (Var v, NoOffset); - add_new_block ctx.local (ask_of_ctx ctx) varin - end - | _ -> ctx.local + | _ -> t let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } From 96916bb48a8f87577522c84918b87b32beba1c07 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 25 Jul 2024 11:01:17 +0200 Subject: [PATCH 268/323] no need to calculate the closure of disequalities after an insertion (I think) --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index bbf321bdc1..2f6f267f3a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -866,7 +866,7 @@ module CongruenceClosure = struct match cc with | None -> (t, Z.zero), None | Some cc -> let (r, z), cc = insert cc t in - (r, z), congruence_neq_opt cc [] + (r, z), cc (** Add all terms in a specific set to the data structure. From 94d289657958aa5aa811f2a58d82f844a3070ec2 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 10:23:46 +0200 Subject: [PATCH 269/323] fixed enter/combine --- src/analyses/c2poAnalysis.ml | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 41d6995735..07c1c21568 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -165,6 +165,11 @@ struct if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); [ctx.local, new_state] + let remove_out_of_scope_vars t f = + let local_vars = f.sformals @ f.slocals in + let duplicated_vars = List.map duplicated_variable f.sformals in + D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t + (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) let combine_env ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = @@ -180,20 +185,21 @@ struct if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; let local = D.remove_tainted_terms ask tainted state_with_assignments in let t = D.meet local t in + let t = remove_out_of_scope_vars t f in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t (*ctx.local is after combine_env, t callee*) let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = - let t = ctx.local in + (* assign function parameters to duplicated values *) + let arg_assigns = GobList.combine_short f.sformals args in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in + let t = D.meet state_with_assignments t in let t = match var_opt with | None -> t | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); - let local_vars = f.sformals @ f.slocals in - let duplicated_vars = List.map duplicated_variable f.sformals in - let t = - D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t + let t = remove_out_of_scope_vars t f in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t let startstate v = D.top () From 9f6cd4b7049df9bce9a10c19573698495b1b9c9f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 10:24:49 +0200 Subject: [PATCH 270/323] fixed realloc --- src/analyses/c2poAnalysis.ml | 2 +- src/cdomains/congruenceClosure.ml | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 07c1c21568..2ab3a9f689 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -131,7 +131,7 @@ struct (let s, lterm = T.get_element_size_in_bits (typeOfLval varin), T.of_lval ask varin in let t = D.remove_may_equal_terms ask s lterm ctx.local in begin match desc.special exprs with - | Malloc _ | Calloc _ | Alloca _ | Realloc _ -> + | Malloc _ | Calloc _ | Alloca _ -> add_block_diseqs t lterm | _ -> t end) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2f6f267f3a..7c3663e1f3 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -593,6 +593,7 @@ module CongruenceClosure = struct (edge_z, t, TUF.find_no_pc uf res_t)) @@ (LMap.zmap_bindings zmap))) (LMap.bindings map) + let compute_min_repr_if_necessary cc = if GobConfig.get_bool "ana.c2po.normal_form" then match cc.min_repr with From b4028a18cbcdfbc30ed7640ee28f93d306dc2f90 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 11:06:53 +0200 Subject: [PATCH 271/323] rename module to c2po --- src/analyses/c2poAnalysis.ml | 2 +- src/cdomains/c2poDomain.ml | 2 +- src/cdomains/congruenceClosure.ml | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 2ab3a9f689..e3d393f395 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -4,7 +4,7 @@ open Analyses open GoblintCil open C2poDomain open CongruenceClosure -open CongruenceClosure +open C2PO open Batteries open SingleThreadedLifter diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 29648ed266..90cc5072ff 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -3,7 +3,7 @@ open Batteries open GoblintCil open CongruenceClosure -open CongruenceClosure +open C2PO module M = Messages module Var = CilType.Varinfo diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 7c3663e1f3..d01b71e9c1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -6,7 +6,7 @@ module Var = CilType.Varinfo module M = Messages (** Quantitative congruence closure on terms *) -module CongruenceClosure = struct +module C2PO = struct module TUF = UnionFind module LMap = LookupMap @@ -1221,7 +1221,7 @@ end (**Find out if two addresses are not equal by using the MayPointTo query*) module MayBeEqual = struct - open CongruenceClosure + open C2PO module AD = Queries.AD let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} From b77fec3e14beace1789c79d693f069234f7d0207 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 11:43:11 +0200 Subject: [PATCH 272/323] made normal form a lazy record field --- src/analyses/c2poAnalysis.ml | 4 +-- src/cdomains/c2poDomain.ml | 14 +++++----- src/cdomains/congruenceClosure.ml | 43 ++++++++++++------------------- src/cdomains/unionFind.ml | 5 ++-- 4 files changed, 28 insertions(+), 38 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index e3d393f395..2718bbffb8 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -95,7 +95,7 @@ struct let valid_props = T.filter_valid_pointers props in let res = if List.is_empty valid_props then ctx.local else - recompute_min_repr (meet_conjs_opt valid_props ctx.local) + reset_normal_form (meet_conjs_opt valid_props ctx.local) in if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s; is_bot: %b\n" d_exp e pos (show_conj valid_props) (D.is_bot res); @@ -107,7 +107,7 @@ struct let assign_return ask t return_var expr = (* the return value is not stored on the heap, therefore we don't need to remove any terms *) match T.of_cil ask expr with - | (Some term, Some offset) -> recompute_min_repr (meet_conjs_opt [Equal (return_var, term, offset)] t) + | (Some term, Some offset) -> reset_normal_form (meet_conjs_opt [Equal (return_var, term, offset)] t) | _ -> t let return ctx exp_opt f = diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 90cc5072ff..d68661fed2 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -45,7 +45,7 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal eq classes. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res - let equal_min_repr x y = + let equal_normal_form x y = let res = match x, y with | Some x, Some y -> if exactly_equal x y then @@ -58,7 +58,7 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal min repr. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res - let equal a b = if GobConfig.get_bool "ana.c2po.normal_form" then equal_min_repr a b else equal_standard a b + let equal a b = if GobConfig.get_bool "ana.c2po.normal_form" then equal_normal_form a b else equal_standard a b let empty () = Some init_cc @@ -89,7 +89,7 @@ module D = struct in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); - Option.map compute_min_repr_if_necessary res + Option.map compute_normal_form_if_necessary res let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then (if M.tracing then M.trace "c2po-join" "Join Automaton"; join a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join a b join_eq_no_automata) @@ -112,7 +112,7 @@ module D = struct in if M.tracing then M.tracel "c2po-join" "WIDEN. WIDEN: %s\n" (show_all res); - Option.map compute_min_repr_if_necessary res + Option.map compute_normal_form_if_necessary res let widen a b = if M.tracing then M.trace "c2po-join" "WIDEN\n"; if GobConfig.get_bool "ana.c2po.precise_join" then join a b(*TODO*) else widen_eq_classes a b @@ -128,7 +128,7 @@ module D = struct else match get_conjunction a with | [] -> b' - | a_conj -> recompute_min_repr (meet_conjs_opt a_conj b') + | a_conj -> reset_normal_form (meet_conjs_opt a_conj b') in if M.tracing then M.trace "c2po-meet" "MEET RESULT = %s" (show res); res @@ -144,7 +144,7 @@ module D = struct else let b_conj = List.filter (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_conjunction b) in - recompute_min_repr (meet_conjs_opt b_conj (Some a)) + reset_normal_form (meet_conjs_opt b_conj (Some a)) in if M.tracing then M.trace "c2po-meet" "NARROW RESULT = %s" (show res);res let pretty_diff () (x,y) = Pretty.dprintf "" @@ -156,7 +156,7 @@ module D = struct (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) - (XmlUtil.escape (Format.asprintf "%s" (MRMap.show_min_rep_opt x.min_repr))) + (XmlUtil.escape (Format.asprintf "%s" (show_conj (Lazy.force x.normal_form)))) (*TODO*) (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) | None -> BatPrintf.fprintf f "\nbottom\n\n" diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index d01b71e9c1..332f5f65ad 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -478,12 +478,7 @@ module C2PO = struct s ^ "\tState: " ^ T.show state ^ "\n\tMin: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")--\n\n" in - List.fold_left show_one_rep "" (bindings min_representatives) - - let show_min_rep_opt min_repr_opt = - match min_repr_opt with - | None -> "None" - | Some min_repr -> show_min_rep min_repr + List.fold_left show_one_rep "" (bindings (Lazy.force min_representatives)) let rec update_min_repr (uf, set, map) min_representatives = function | [] -> min_representatives, uf @@ -533,7 +528,6 @@ module C2PO = struct (** Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. - It's used for now when removing elements, then the min_repr map gets recomputed. Returns: - The map with the minimal representatives @@ -568,10 +562,16 @@ module C2PO = struct List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) end + module Lazy = + struct + include Lazy + let hash x y = 0 + end + type t = {uf: TUF.t; set: SSet.t; map: LMap.t; - min_repr: MRMap.t option; + normal_form: T.v_prop list Lazy.t[@compare.ignore][@eq.ignore][@hash.ignore]; diseq: Disequalities.t; bldis: BlDis.t} [@@deriving eq, ord, hash] @@ -594,17 +594,9 @@ module C2PO = struct (LMap.zmap_bindings zmap))) (LMap.bindings map) - let compute_min_repr_if_necessary cc = - if GobConfig.get_bool "ana.c2po.normal_form" then - match cc.min_repr with - | None -> let min_repr, uf = - MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in - {cc with min_repr = Some min_repr; uf} - | Some min_repr -> cc - else cc + let compute_normal_form_if_necessary cc = cc - let recompute_min_repr = - Option.map (fun cc -> compute_min_repr_if_necessary {cc with min_repr=None}) + let reset_normal_form cc = cc let exactly_equal cc1 cc2 = cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis @@ -657,8 +649,7 @@ module C2PO = struct Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = - let min_repr = Option.get cc.min_repr in - get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + Lazy.force cc.normal_form (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) @@ -679,7 +670,7 @@ module C2PO = struct ^ "\nBlock diseqs:\n" ^ show_conj(BlDis.to_conj x.bldis) ^ "\nMin repr:\n" - ^ MRMap.show_min_rep_opt x.min_repr + ^ show_conj (Lazy.force x.normal_form) (*TODO only print if it's already been lazy.forced*) (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) @@ -700,7 +691,7 @@ module C2PO = struct - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. *) let init_cc = - {uf = TUF.empty; set = SSet.empty; map = LMap.empty; min_repr = None; diseq = Disequalities.empty; bldis = BlDis.empty} + {uf = TUF.empty; set = SSet.empty; map = LMap.empty; normal_form = lazy([]); diseq = Disequalities.empty; bldis = BlDis.empty} (** closure of disequalities *) let congruence_neq cc neg = @@ -715,7 +706,7 @@ module C2PO = struct let neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) cc.bldis neq_list in if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); - Some {uf; set=cc.set; map=cc.map; min_repr=cc.min_repr;diseq=neq; bldis=cc.bldis} + Some {uf; set=cc.set; map=cc.map; normal_form=cc.normal_form;diseq=neq; bldis=cc.bldis} with Unsat -> None let congruence_neq_opt cc neq = match cc with @@ -817,7 +808,7 @@ module C2PO = struct | Some cc -> let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in let bldis = update_bldis new_repr cc.bldis in - Some {uf; set = cc.set; map; min_repr=cc.min_repr; diseq=cc.diseq; bldis=bldis} + Some {uf; set = cc.set; map; normal_form=cc.normal_form; diseq=cc.diseq; bldis=bldis} (** Adds the block disequalities to the cc, but first rewrites them such that they are disequalities between representatives. The cc should already contain @@ -1053,11 +1044,11 @@ module C2PO = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = let old_cc = cc in - match remove_terms_from_eq predicate {cc with min_repr=None} with + match remove_terms_from_eq predicate (reset_normal_form cc) with | new_reps, Some cc -> let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with bldis} in - Option.map compute_min_repr_if_necessary cc + Option.map compute_normal_form_if_necessary cc | _,None -> None (* join version 1: by using the automaton *) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index e85643662e..b52f2ccc54 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -26,10 +26,9 @@ module T = struct let equal_exp _ _ = true let hash_exp _ = 1 - (* we store the varinfo and the Cil expression corresponding to the term in the data type *) - type t = (Var.t, exp) term [@@deriving eq, ord, hash] - type v_prop = (Var.t, exp) prop [@@deriving hash] + type t = (Var.t, exp[@compare.ignore][@eq.ignore][@hash.ignore]) term [@@deriving eq, ord, hash] + type v_prop = (Var.t, exp[@compare.ignore][@eq.ignore][@hash.ignore]) prop [@@deriving hash] let compare t1 t2 = match t1,t2 with From 407d8cfa60e8867e18e59a1b606995be80bb22a9 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 11:44:31 +0200 Subject: [PATCH 273/323] fixed warning --- src/cdomains/congruenceClosure.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 332f5f65ad..2eaa56c87a 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -58,7 +58,7 @@ module C2PO = struct match TMap.find_opt t cmap with | None -> [Z.zero, t] | Some zmap -> - List.flatten @@ List.map + List.concat_map (fun (z, set) -> List.cartesian_product [z] (TSet.to_list (*TSet.filter (TUF.is_root uf*) set)) (ZMap.bindings zmap) From 2255dc09738165bc4b864f8a10e07b95e31df895 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 13:43:15 +0200 Subject: [PATCH 274/323] recompute min_repr in the appropriate places --- src/analyses/c2poAnalysis.ml | 10 +++++----- src/cdomains/c2poDomain.ml | 6 +++--- src/cdomains/congruenceClosure.ml | 27 +++++++++++++++++++-------- 3 files changed, 27 insertions(+), 16 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 2718bbffb8..f12ddddf0a 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -87,7 +87,7 @@ struct | _ -> D.top () let assign ctx lval expr = - let res = assign_lval ctx.local (ask_of_ctx ctx) lval expr in + let res = reset_normal_form @@ assign_lval ctx.local (ask_of_ctx ctx) lval expr in if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "None" res); res let branch ctx e pos = @@ -132,7 +132,7 @@ struct let t = D.remove_may_equal_terms ask s lterm ctx.local in begin match desc.special exprs with | Malloc _ | Calloc _ | Alloca _ -> - add_block_diseqs t lterm + reset_normal_form @@ add_block_diseqs t lterm | _ -> t end) with (T.UnsupportedCilExpression _) -> D.top () @@ -163,7 +163,7 @@ struct in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); - [ctx.local, new_state] + [ctx.local, reset_normal_form new_state] let remove_out_of_scope_vars t f = let local_vars = f.sformals @ f.slocals in @@ -185,7 +185,7 @@ struct if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; let local = D.remove_tainted_terms ask tainted state_with_assignments in let t = D.meet local t in - let t = remove_out_of_scope_vars t f in + let t = reset_normal_form @@ remove_out_of_scope_vars t f in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t (*ctx.local is after combine_env, t callee*) @@ -199,7 +199,7 @@ struct | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); - let t = remove_out_of_scope_vars t f + let t = reset_normal_form @@ remove_out_of_scope_vars t f in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t let startstate v = D.top () diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index d68661fed2..bef6126923 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -89,7 +89,7 @@ module D = struct in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); - Option.map compute_normal_form_if_necessary res + reset_normal_form res let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then (if M.tracing then M.trace "c2po-join" "Join Automaton"; join a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join a b join_eq_no_automata) @@ -112,7 +112,7 @@ module D = struct in if M.tracing then M.tracel "c2po-join" "WIDEN. WIDEN: %s\n" (show_all res); - Option.map compute_normal_form_if_necessary res + reset_normal_form res let widen a b = if M.tracing then M.trace "c2po-join" "WIDEN\n"; if GobConfig.get_bool "ana.c2po.precise_join" then join a b(*TODO*) else widen_eq_classes a b @@ -156,7 +156,7 @@ module D = struct (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) - (XmlUtil.escape (Format.asprintf "%s" (show_conj (Lazy.force x.normal_form)))) (*TODO*) + (XmlUtil.escape (Format.asprintf "%s" (show_normal_form x.normal_form))) (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) | None -> BatPrintf.fprintf f "\nbottom\n\n" diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 2eaa56c87a..823f49b234 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -478,7 +478,7 @@ module C2PO = struct s ^ "\tState: " ^ T.show state ^ "\n\tMin: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")--\n\n" in - List.fold_left show_one_rep "" (bindings (Lazy.force min_representatives)) + List.fold_left show_one_rep "" (bindings min_representatives) let rec update_min_repr (uf, set, map) min_representatives = function | [] -> min_representatives, uf @@ -594,10 +594,6 @@ module C2PO = struct (LMap.zmap_bindings zmap))) (LMap.bindings map) - let compute_normal_form_if_necessary cc = cc - - let reset_normal_form cc = cc - let exactly_equal cc1 cc2 = cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis @@ -651,12 +647,27 @@ module C2PO = struct let get_normal_form cc = Lazy.force cc.normal_form + (** COnverts normal form to string, but only if it was already computed. *) + let show_normal_form normal_form = + if Lazy.is_val normal_form then show_conj (Lazy.force normal_form) + else "not computed" + (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) (** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) let get_conjunction cc = get_normal_conjunction cc (fun t -> t,Z.zero) + let reset_normal_form cc = + match cc with + | None -> None + | Some cc -> + let min_repr = fst(MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map)) in + Some {cc with normal_form = lazy( + get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + )} + + let show_all x = "Normal form:\n" ^ show_conj((get_conjunction x)) ^ "Union Find partition:\n" ^ @@ -670,7 +681,7 @@ module C2PO = struct ^ "\nBlock diseqs:\n" ^ show_conj(BlDis.to_conj x.bldis) ^ "\nMin repr:\n" - ^ show_conj (Lazy.force x.normal_form) (*TODO only print if it's already been lazy.forced*) + ^ show_normal_form x.normal_form (** Splits the conjunction into two groups: the first one contains all equality propositions, and the second one contains all inequality propositions. *) @@ -1044,11 +1055,11 @@ module C2PO = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = let old_cc = cc in - match remove_terms_from_eq predicate (reset_normal_form cc) with + match remove_terms_from_eq predicate cc with | new_reps, Some cc -> let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with bldis} in - Option.map compute_normal_form_if_necessary cc + cc | _,None -> None (* join version 1: by using the automaton *) From d155b89b2c8b0faddb7f77c5cb8e3ca73d0b8f93 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 13:45:53 +0200 Subject: [PATCH 275/323] indentation --- src/cdomains/congruenceClosure.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 823f49b234..74351fd72b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -662,10 +662,10 @@ module C2PO = struct match cc with | None -> None | Some cc -> - let min_repr = fst(MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map)) in - Some {cc with normal_form = lazy( - get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) - )} + let min_repr = fst(MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map)) in + Some {cc with normal_form = lazy( + get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + )} let show_all x = "Normal form:\n" ^ From fe6e9d0dd1234709c51a25096744ae854ce098cc Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 14:04:42 +0200 Subject: [PATCH 276/323] add tracing --- src/cdomains/c2poDomain.ml | 4 +++- src/cdomains/congruenceClosure.ml | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index bef6126923..cc85764666 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -58,7 +58,9 @@ module D = struct | _ -> false in if M.tracing then M.trace "c2po-equal" "equal min repr. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res - let equal a b = if GobConfig.get_bool "ana.c2po.normal_form" then equal_normal_form a b else equal_standard a b + let equal a b = + if M.tracing then M.trace "c2po-normal-form" "COMPUTING EQUAL"; + if GobConfig.get_bool "ana.c2po.normal_form" then equal_normal_form a b else equal_standard a b let empty () = Some init_cc diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 74351fd72b..d89032621f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -645,6 +645,7 @@ module C2PO = struct Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = + if M.tracing && not (Lazy.is_val cc.normal_form) then M.trace "c2po-normal-form" "Computing normal form"; Lazy.force cc.normal_form (** COnverts normal form to string, but only if it was already computed. *) From cd48307e839da26ec66a71d139aaad33837e29f8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 15:24:36 +0200 Subject: [PATCH 277/323] a bit more path compression --- src/cdomains/c2poDomain.ml | 4 +- src/cdomains/congruenceClosure.ml | 134 ++++++++++++++++-------------- src/cdomains/unionFind.ml | 45 +++++----- 3 files changed, 94 insertions(+), 89 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index cc85764666..8d025587c5 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -85,7 +85,7 @@ module D = struct (if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); let cc = fst(join_cc_function a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + let cmap1, cmap2 = fst(Disequalities.comp_map a.uf), fst(Disequalities.comp_map b.uf) in let cc = Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc in Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2)) in @@ -108,7 +108,7 @@ module D = struct (if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" (show_all (Some a)) (show_all (Some b)); let cc = fst(widen_eq_no_automata a b) in - let cmap1, cmap2 = Disequalities.comp_map a.uf, Disequalities.comp_map b.uf + let cmap1, cmap2 = fst(Disequalities.comp_map a.uf), fst(Disequalities.comp_map b.uf) in let cc = Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2) in Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc) in diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index d89032621f..6f2ce735b1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -172,18 +172,20 @@ module C2PO = struct (** Map of partition, transform union find to a map of type V -> Z -> V set with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) - let comp_map uf = List.fold_left (fun comp (v,_) -> - map_set_add (TUF.find_no_pc uf v) v comp) - TMap.empty (TMap.bindings uf) + let comp_map uf = + List.fold_left (fun (comp,uf) (v,_) -> + let t,z,uf = TUF.find uf v in + map_set_add (t,z) v comp,uf) + (TMap.empty, uf) (TMap.bindings uf) (** Find all elements that are in the same equivalence class as t. *) let comp_t uf t = - let (t',z') = TUF.find_no_pc uf t in - List.fold_left (fun comp (v,((p,z),_)) -> - let (v', z'') = TUF.find_no_pc uf v in - if T.equal v' t' then (v, Z.(z'-z''))::comp else comp + let (t',z',uf) = TUF.find uf t in + fst(List.fold_left (fun (comp,uf) (v,((p,z),_)) -> + let v', z'',uf = TUF.find uf v in + if T.equal v' t' then (v, Z.(z'-z''))::comp,uf else comp,uf ) - [] (TMap.bindings uf) + ([],uf) (TMap.bindings uf)) (** arg: @@ -193,16 +195,17 @@ module C2PO = struct It basically maps each state in the automata to its predecessors. *) let get_args uf = - let cmap = comp_map uf in + let cmap,uf = comp_map uf in let clist = TMap.bindings cmap in let arg = List.fold_left (fun arg (v, imap) -> let ilist = ZMap.bindings imap in let iarg = List.fold_left (fun iarg (r,set) -> - let list = List.filter_map (function + let uf,list = List.fold_left (fun (uf,list) el -> + match el with | Deref (v', r', _) -> - let (v0,r0) = TUF.find_no_pc uf v' in - Some (v0,Z.(r0+r')) - | _ -> None) (TSet.elements set) in + let v0,r0,uf = TUF.find uf v' in + uf,(v0,Z.(r0+r'))::list + | _ -> uf,list) (uf,[]) (TSet.elements set) in ZMap.add r list iarg) ZMap.empty ilist in TMap.add v iarg arg) TMap.empty clist in (uf,cmap,arg) @@ -281,12 +284,12 @@ module C2PO = struct Returns: list of normalized provided dis-equalities *) let init_list_neq uf neg = - List.filter_map (fun (v1,v2,r) -> - let (v1,r1) = TUF.find_no_pc uf v1 in - let (v2,r2) = TUF.find_no_pc uf v2 in + List.fold_left (fun (uf, list) (v1,v2,r) -> + let v1,r1,uf = TUF.find uf v1 in + let v2,r2,uf = TUF.find uf v2 in if T.equal v1 v2 then if Z.(equal r1 (r2+r)) then raise Unsat - else None - else Some (v1,v2,Z.(r2-r1+r))) neg + else uf,list + else uf,(v1,v2,Z.(r2-r1+r))::list) (uf,[]) neg (** Parameter: list of disequalities (t1, t2, z), where t1 and t2 are roots. @@ -481,12 +484,12 @@ module C2PO = struct List.fold_left show_one_rep "" (bindings min_representatives) let rec update_min_repr (uf, set, map) min_representatives = function - | [] -> min_representatives, uf + | [] -> min_representatives | state::queue -> (* process all outgoing edges in order of ascending edge labels *) match LMap.successors state map with | edges -> let process_edge (min_representatives, queue, uf) (edge_z, next_term) = - let next_state, next_z, uf = TUF.find uf next_term in + let next_state, next_z = TUF.find_no_pc uf next_term in let (min_term, min_z) = find state min_representatives in let next_min = (SSet.deref_term_even_if_its_not_possible min_term Z.(edge_z - min_z) set, next_z) in @@ -536,18 +539,15 @@ module C2PO = struct if M.tracing then M.trace "c2po" "compute_minimal_representatives\n"; let atoms = SSet.get_atoms set in (* process all atoms in increasing order *) - let uf_ref = ref uf in let atoms = List.sort (fun el1 el2 -> - let v1, z1, new_uf = TUF.find !uf_ref el1 in - uf_ref := new_uf; - let v2, z2, new_uf = TUF.find !uf_ref el2 in - uf_ref := new_uf; + let v1, z1 = TUF.find_no_pc uf el1 in + let v2, z2 = TUF.find_no_pc uf el2 in let repr_compare = TUF.compare_repr (v1, z1) (v2, z2) in if repr_compare = 0 then T.compare el1 el2 else repr_compare) atoms in let add_atom_to_map (min_representatives, queue, uf) a = - let (rep, offs, uf) = TUF.find uf a in + let rep, offs = TUF.find_no_pc uf a in if not (mem rep min_representatives) then (add rep (a, offs) min_representatives, queue @ [rep], uf) else (min_representatives, queue, uf) @@ -663,7 +663,7 @@ module C2PO = struct match cc with | None -> None | Some cc -> - let min_repr = fst(MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map)) in + let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in Some {cc with normal_form = lazy( get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) )} @@ -715,7 +715,7 @@ module C2PO = struct let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap, arg) in let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) cc.bldis neq_list in (* taking explicit dis-equalities into account *) - let neq_list = Disequalities.init_list_neq uf neg in + let uf,neq_list = Disequalities.init_list_neq uf neg in let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) cc.bldis neq_list in if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); Some {uf; set=cc.set; map=cc.map; normal_form=cc.normal_form;diseq=neq; bldis=cc.bldis} @@ -832,11 +832,11 @@ module C2PO = struct match cc with | None -> None | Some cc -> - let t1' = fst (TUF.find_no_pc cc.uf t1) in - let t2' = fst (TUF.find_no_pc cc.uf t2) in + let t1',_,uf = TUF.find cc.uf t1 in + let t2',_,uf = TUF.find uf t2 in if T.equal t1' t2' then None (*unsatisfiable*) else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in - add_normalized_bl_diseqs (Some {cc with bldis}) bl_conjs + add_normalized_bl_diseqs (Some {cc with bldis;uf}) bl_conjs (** Add a term to the data structure. @@ -967,19 +967,19 @@ module C2PO = struct old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) (* the representative need to be removed from the data structure: state is the new repr.*) state, Z.zero, TMap.add old_rep (state, old_z) new_reps in - let add_atom (new_reps, new_cc, reachable_old_reps) state = - let old_rep, old_z = TUF.find_no_pc cc.uf state in + let add_atom (uf, new_reps, new_cc, reachable_old_reps) state = + let old_rep, old_z, uf = TUF.find uf state in let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in let new_cc = insert_terms new_cc [state; new_rep] in let new_cc = closure new_cc [(state, new_rep, new_z)] in - (new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) + (uf, new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) in - let new_reps, new_cc, reachable_old_reps = - SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (TMap.empty, (Some init_cc),[]) cc.set in - let cmap = Disequalities.comp_map cc.uf in + let uf, new_reps, new_cc, reachable_old_reps = + SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (cc.uf, TMap.empty, (Some init_cc),[]) cc.set in + let cmap,uf = Disequalities.comp_map uf in (* breadth-first search of reachable states *) - let add_transition (old_rep, new_rep, z1) (new_reps, new_cc, reachable_old_reps) (s_z,s_t) = - let old_rep_s, old_z_s = TUF.find_no_pc cc.uf s_t in + let add_transition (old_rep, new_rep, z1) (uf, new_reps, new_cc, reachable_old_reps) (s_z,s_t) = + let old_rep_s, old_z_s, uf = TUF.find uf s_t in let find_successor_in_set (z, term_set) = let exception Found in let res = ref None in @@ -1000,56 +1000,64 @@ module C2PO = struct let new_cc = insert_terms new_cc [successor_term] in match LMap.find_opt old_rep_s new_reps with | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) - new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps + uf, new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. -> we choose a successor term *(t+z) for any -> we need add the successor state to the list of states that still need to be visited *) - TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps + uf, TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps else - (new_reps, new_cc, reachable_old_reps) + (uf, new_reps, new_cc, reachable_old_reps) | None -> (* the term cannot be dereferenced, so we won't add this transition. *) - (new_reps, new_cc, reachable_old_reps) + (uf, new_reps, new_cc, reachable_old_reps) in (* find all successors that are still reachable *) - let rec add_transitions new_reps new_cc = function + let rec add_transitions uf new_reps new_cc = function | [] -> new_reps, new_cc | (old_rep, new_rep, z)::rest -> let successors = LMap.successors old_rep cc.map in - let new_reps, new_cc, reachable_old_reps = - List.fold (add_transition (old_rep, new_rep,z)) (new_reps, new_cc, []) successors in - add_transitions new_reps new_cc (rest@reachable_old_reps) - in add_transitions new_reps new_cc + let uf, new_reps, new_cc, reachable_old_reps = + List.fold (add_transition (old_rep, new_rep,z)) (uf, new_reps, new_cc, []) successors in + add_transitions uf new_reps new_cc (rest@reachable_old_reps) + in add_transitions uf new_reps new_cc (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. Returns None if there are no elements in the same equivalence class as t before it was deleted.*) let find_new_root new_reps uf v = match TMap.find_opt v new_reps with - | None -> None + | None -> uf, None | Some (new_t, z1) -> - let t_rep, z2 = TUF.find_no_pc uf new_t in - Some (t_rep, Z.(z2-z1)) + let t_rep, z2, uf = TUF.find uf new_t in + uf, Some (t_rep, Z.(z2-z1)) let remove_terms_from_diseq diseq new_reps cc = let disequalities = Disequalities.get_disequalities diseq in - let add_disequality new_diseq = function + let add_disequality (uf,new_diseq) = function | Nequal(t1,t2,z) -> - begin match find_new_root new_reps cc.uf t1,find_new_root new_reps cc.uf t2 with - | Some (t1',z1'), Some (t2', z2') -> (t1', t2', Z.(z2'+z-z1'))::new_diseq - | _ -> new_diseq + begin match find_new_root new_reps uf t1 with + | uf, Some (t1',z1') -> + begin match find_new_root new_reps uf t2 with + | uf, Some (t2', z2') -> uf, (t1', t2', Z.(z2'+z-z1'))::new_diseq + | _ -> uf, new_diseq + end + | _ -> uf, new_diseq end - | _-> new_diseq + | _-> uf, new_diseq in - let new_diseq = List.fold add_disequality [] disequalities - in congruence_neq cc new_diseq + let uf,new_diseq = List.fold add_disequality (cc.uf,[]) disequalities + in congruence_neq {cc with uf} new_diseq let remove_terms_from_bldis bldis new_reps cc = - let find_new_root_term t = Option.map fst (find_new_root new_reps cc.uf t) in + let uf_ref = ref cc.uf in + let find_new_root_term t = + let uf, new_root = find_new_root new_reps !uf_ref t in + uf_ref := uf; + Option.map fst new_root in let bldis = BlDis.filter_map_lhs find_new_root_term bldis in - BlDis.filter_map find_new_root_term bldis + !uf_ref, BlDis.filter_map find_new_root_term bldis (** Remove terms from the data structure. It removes all terms for which "predicate" is false, @@ -1058,8 +1066,8 @@ module C2PO = struct let old_cc = cc in match remove_terms_from_eq predicate cc with | new_reps, Some cc -> - let bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with bldis} in + let uf,bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in + let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with uf;bldis} in cc | _,None -> None @@ -1168,7 +1176,7 @@ module C2PO = struct (** Compares the equivalence classes of cc1 and those of cc2. *) let equal_eq_classes cc1 cc2 = - let comp1, comp2 = Disequalities.comp_map cc1.uf, Disequalities.comp_map cc2.uf in + let comp1, comp2 = fst(Disequalities.comp_map cc1.uf), fst(Disequalities.comp_map cc2.uf) in (* they should have the same number of equivalence classes *) if TMap.cardinal comp1 <> TMap.cardinal comp2 then false else (* compare each equivalence class of cc1 with the corresponding eq. class of cc2 *) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index b52f2ccc54..8b5bcf6441 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -28,7 +28,7 @@ module T = struct (* we store the varinfo and the Cil expression corresponding to the term in the data type *) type t = (Var.t, exp[@compare.ignore][@eq.ignore][@hash.ignore]) term [@@deriving eq, ord, hash] - type v_prop = (Var.t, exp[@compare.ignore][@eq.ignore][@hash.ignore]) prop [@@deriving hash] + type v_prop = (Var.t, exp[@hash.ignore]) prop [@@deriving hash] let compare t1 t2 = match t1,t2 with @@ -586,19 +586,20 @@ module UnionFind = struct (* the parent of v is a root *) v',r', uf else - let rec search v list = - let (v',r') = parent uf v in - if is_root uf v' then - (* perform path compresion *) - let (r',uf) = List.fold_left (fun (r0, uf) v -> - let (parent_v, r''), size_v = ValMap.find v uf in - let uf = modify_parent uf v (v',Z.(r0+r'')) in - let uf = modify_size parent_v uf (fun s -> s - size_v) in - let uf = modify_size v' uf ((+) size_v) - in Z.(r0+r''),uf) (Z.zero, uf) (v::list) - in v',r',uf - else search v' (v :: list) - in search v' [v] + (if M.tracing then M.trace "c2po-find" "find DEEP TREE"; + let rec search v list = + let (v',r') = parent uf v in + if is_root uf v' then + (* perform path compresion *) + let (r',uf) = List.fold_left (fun (r0, uf) v -> + let (parent_v, r''), size_v = ValMap.find v uf in + let uf = modify_parent uf v (v',Z.(r0+r'')) in + let uf = modify_size parent_v uf (fun s -> s - size_v) in + let uf = modify_size v' uf ((+) size_v) + in Z.(r0+r''),uf) (Z.zero, uf) (v::list) + in v',r',uf + else search v' (v :: list) + in search v' [v]) (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) let find_opt uf v = match find uf v with @@ -619,16 +620,12 @@ module UnionFind = struct if T.equal v' v then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") - else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) - - (** Returns find of v if v is in the union find data structure. - Otherwise it just returns v. *) - let find_no_pc_if_possible uf v = - match find_no_pc uf v with - | exception (UnknownValue _) - | exception Not_found - | exception (InvalidUnionFind _) -> v, Z.zero - | res -> res + else if is_root uf v' then + (* the parent of v is a root *) + v',r' + else + (if M.tracing then M.trace "c2po-find" "find_no_pc DEEP TREE"; + let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r''))) let compare_repr = Tuple2.compare ~cmp1:T.compare ~cmp2:Z.compare From 0576b893c9774c302eabd0acde7c27609d684053 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 15:27:37 +0200 Subject: [PATCH 278/323] restore find_no_pc --- src/cdomains/unionFind.ml | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 8b5bcf6441..2b25a71ce9 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -620,12 +620,7 @@ module UnionFind = struct if T.equal v' v then if Z.equal r' Z.zero then (v',r') else raise (InvalidUnionFind "non-zero self-distance!") - else if is_root uf v' then - (* the parent of v is a root *) - v',r' - else - (if M.tracing then M.trace "c2po-find" "find_no_pc DEEP TREE"; - let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r''))) + else let (v'', r'') = find_no_pc uf v' in (v'', Z.(r'+r'')) let compare_repr = Tuple2.compare ~cmp1:T.compare ~cmp2:Z.compare From 13c4de637f413df99352c1dd1628c0a33423a7b9 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 29 Jul 2024 15:51:20 +0200 Subject: [PATCH 279/323] Timing.wrap --- src/cdomains/c2poDomain.ml | 4 +++- src/cdomains/congruenceClosure.ml | 2 ++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 8d025587c5..b61f8a27fa 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -96,6 +96,8 @@ module D = struct let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then (if M.tracing then M.trace "c2po-join" "Join Automaton"; join a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join a b join_eq_no_automata) + let join a b = Timing.wrap "join" (join a) b + let widen_eq_classes a' b' = let res = match a',b' with @@ -116,7 +118,7 @@ module D = struct (show_all res); reset_normal_form res - let widen a b = if M.tracing then M.trace "c2po-join" "WIDEN\n"; + let widen a b = if M.tracing then M.trace "c2po-widen" "WIDEN\n"; if GobConfig.get_bool "ana.c2po.precise_join" then join a b(*TODO*) else widen_eq_classes a b let meet a' b' = diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 6f2ce735b1..c25ef7f5fc 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1071,6 +1071,8 @@ module C2PO = struct cc | _,None -> None + let remove_terms p cc = Timing.wrap "removing terms" (remove_terms p) cc + (* join version 1: by using the automaton *) let show_pmap pmap= From 4527ece61ddd2ab47270b12adc2cb519f775aa26 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 30 Jul 2024 10:34:15 +0200 Subject: [PATCH 280/323] solved invariant bug in a better way --- src/analyses/c2poAnalysis.ml | 10 +++++----- src/cdomains/unionFind.ml | 9 ++++++--- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index f12ddddf0a..10b65c8744 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -38,11 +38,11 @@ struct d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res let conj_to_invariant ask conjs t = - List.fold (fun a prop -> let exp = T.prop_to_cil prop in - if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; - match eval_guard ask t exp with - | Some true -> Invariant.(a && of_exp exp) - | _ -> a) + List.fold (fun a prop -> match T.prop_to_cil prop with + | exception (T.UnsupportedCilExpression _) -> a + | exp -> + if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; + Invariant.(a && of_exp exp)) (Invariant.top()) conjs let query ctx (type a) (q: a Queries.t): a Queries.result = diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 2b25a71ce9..66910850f2 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -245,13 +245,16 @@ module T = struct | None -> Z.one in if Z.equal typ_size Z.zero then Z.zero else - Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) + Z.(z /typ_size) in + Const (CInt (z, default_int_type, Some (Z.to_string z))) let to_cil_sum off cil_t = let res = if Z.(equal zero off) then cil_t else - let typ = typeOf cil_t in - BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) + match typeOf cil_t with + | TPtr (TComp (cinfo, _), _) -> raise (UnsupportedCilExpression "Cil can't represent something like &(c->d).") + | typ -> + BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) in if M.tracing then M.trace "c2po-2cil" "exp: %a; offset: %s; res: %a" d_exp cil_t (Z.to_string off) d_exp res;res let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with From a25ef2207b10f8f7087fcbecb6d396afbb035568 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 30 Jul 2024 10:55:37 +0200 Subject: [PATCH 281/323] ask MayBeTainted in combine_env instead of start State --- src/analyses/c2poAnalysis.ml | 3 +-- src/analyses/startStateAnalysis.ml | 7 ++----- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 10b65c8744..b866f82d0d 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -179,8 +179,7 @@ struct let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) - let tainted = (* find out the tainted variables from startState *) - ask.f (MayPointTo (MayBeEqual.return_lval (dummyFunDec.svar.vtype))) + let tainted = ask.f (MayBeTainted) in if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; let local = D.remove_tainted_terms ask tainted state_with_assignments in diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 5148d990e4..d92de10874 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -50,14 +50,11 @@ struct (* TODO: there should be a better way to do this, this should be removed here. *) let return ctx exp_opt f = + (* ctx.local *) (* remember all values of local vars *) let st = List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in if M.tracing then M.trace "startState" "return: added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; - D.add (var) value st) (D.empty()) (f.sformals @ f.slocals) in - (* remember value of tainted vars in the return variable *) - let tainted = ctx.ask (MayBeTainted) in - let st = D.add return_varinfo tainted st - in if M.tracing then M.tracel "wrpointer-tainted" "startState: %a; state: %a\n" AD.pretty tainted D.pretty st;st + D.add (var) value st) (D.empty()) (f.sformals @ f.slocals) in st let query ctx (type a) (q: a Queries.t): a Queries.result = From 1ea948874527005d146acbabf431c8d93fcde7c7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 30 Jul 2024 11:05:44 +0200 Subject: [PATCH 282/323] remove the weird hack I put in startState --- src/analyses/c2poAnalysis.ml | 2 +- src/analyses/startStateAnalysis.ml | 7 +------ 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index b866f82d0d..e124fa1931 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -182,7 +182,7 @@ struct let tainted = ask.f (MayBeTainted) in if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; - let local = D.remove_tainted_terms ask tainted state_with_assignments in + let local = D.remove_tainted_terms (ask_of_ctx ctx) tainted state_with_assignments in let t = D.meet local t in let t = reset_normal_form @@ remove_out_of_scope_vars t f in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index d92de10874..76d4388e21 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -50,12 +50,7 @@ struct (* TODO: there should be a better way to do this, this should be removed here. *) let return ctx exp_opt f = - (* ctx.local *) - (* remember all values of local vars *) - let st = List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in - if M.tracing then M.trace "startState" "return: added value: var: %a; value: %a" d_lval (Var var, NoOffset) Value.pretty value; - D.add (var) value st) (D.empty()) (f.sformals @ f.slocals) in st - + ctx.local let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in From cc148ef94a15afa01cd1a325cc4b50b4e6f229a9 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 30 Jul 2024 11:08:12 +0200 Subject: [PATCH 283/323] simplify redundant definitions in startState --- src/analyses/startStateAnalysis.ml | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 76d4388e21..efd2e839a2 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -48,10 +48,6 @@ struct let startstate v = D.bot () let exitstate = startstate - (* TODO: there should be a better way to do this, this should be removed here. *) - let return ctx exp_opt f = - ctx.local - let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in match q with @@ -59,22 +55,11 @@ struct | EvalValue e -> Address (eval (ask_of_ctx ctx) ctx.local e) | _ -> Result.top q - let enter ctx var_opt f args = - [ctx.local, ctx.local] - let body ctx (f:fundec) = (* assign function parameters *) List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var (duplicated_variable var), NoOffset) Value.pretty value; D.add (duplicated_variable var) value st) (D.empty()) f.sformals - - let combine_env ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc au (f_ask: Queries.ask) = - ctx.local - - let combine_assign ctx var_opt expr f exprs t_context_opt t ask = - (* remove duplicated vars and local vars *) - ctx.local - end let _ = From 82d380211fd95e90eec61f04086d7e27bfda8fbe Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 31 Jul 2024 12:46:49 +0200 Subject: [PATCH 284/323] disable unknown_function.call for c2po conf --- conf/svcomp-c2po-no-maypointto.json | 3 ++- conf/svcomp-c2po.json | 3 ++- conf/svcomp-no-var-eq.json | 3 ++- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/conf/svcomp-c2po-no-maypointto.json b/conf/svcomp-c2po-no-maypointto.json index 12bb959960..2d3b8feffa 100644 --- a/conf/svcomp-c2po-no-maypointto.json +++ b/conf/svcomp-c2po-no-maypointto.json @@ -102,7 +102,8 @@ "solver": "td3", "sem": { "unknown_function": { - "spawn": false + "spawn": false, + "call": false }, "int": { "signed_overflow": "assume_none" diff --git a/conf/svcomp-c2po.json b/conf/svcomp-c2po.json index 7549412730..964a47d464 100644 --- a/conf/svcomp-c2po.json +++ b/conf/svcomp-c2po.json @@ -99,7 +99,8 @@ "solver": "td3", "sem": { "unknown_function": { - "spawn": false + "spawn": false, + "call": false }, "int": { "signed_overflow": "assume_none" diff --git a/conf/svcomp-no-var-eq.json b/conf/svcomp-no-var-eq.json index a903d29e76..e2530ea2ac 100644 --- a/conf/svcomp-no-var-eq.json +++ b/conf/svcomp-no-var-eq.json @@ -96,7 +96,8 @@ "solver": "td3", "sem": { "unknown_function": { - "spawn": false + "spawn": false, + "call": false }, "int": { "signed_overflow": "assume_none" From b55075f50fb3c4bdffeaa48e04d1038c9d826f65 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 31 Jul 2024 13:04:04 +0200 Subject: [PATCH 285/323] added different conf files for the 4 possibilities of c2po --- ...c2po.json => svcomp-c2po1_join_nform.json} | 5 + conf/svcomp-c2po2_nform.json | 154 ++++++++++++++++++ conf/svcomp-c2po3_join.json | 154 ++++++++++++++++++ conf/svcomp-c2po4.json | 154 ++++++++++++++++++ 4 files changed, 467 insertions(+) rename conf/{svcomp-c2po.json => svcomp-c2po1_join_nform.json} (96%) create mode 100644 conf/svcomp-c2po2_nform.json create mode 100644 conf/svcomp-c2po3_join.json create mode 100644 conf/svcomp-c2po4.json diff --git a/conf/svcomp-c2po.json b/conf/svcomp-c2po1_join_nform.json similarity index 96% rename from conf/svcomp-c2po.json rename to conf/svcomp-c2po1_join_nform.json index 964a47d464..73037d685c 100644 --- a/conf/svcomp-c2po.json +++ b/conf/svcomp-c2po1_join_nform.json @@ -91,6 +91,11 @@ "termination", "tmpSpecialAnalysis" ] + }, + "c2po": { + "askbase": true, + "precise_join": true, + "normal_form": true } }, "exp": { diff --git a/conf/svcomp-c2po2_nform.json b/conf/svcomp-c2po2_nform.json new file mode 100644 index 0000000000..a21567475d --- /dev/null +++ b/conf/svcomp-c2po2_nform.json @@ -0,0 +1,154 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "symb_locks", + "region", + "thread", + "threadJoins", + "c2po", + "startState", + "taintPartialContexts" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + }, + "c2po": { + "askbase": true, + "precise_join": false, + "normal_form": true + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false, + "call": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": true, + "id": "enumerate", + "unknown": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "invariant_set" + ], + "invariant-types": [ + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": false, + "other": false, + "accessed": false, + "exact": true, + "exclude-vars": [ + "tmp\\(___[0-9]+\\)?", + "cond", + "RETURN", + "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", + ".*____CPAchecker_TMP_[0-9]+", + "__VERIFIER_assert__cond", + "__ksymtab_.*", + "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" + ] + } + }, + "pre": { + "enabled": false + } + } diff --git a/conf/svcomp-c2po3_join.json b/conf/svcomp-c2po3_join.json new file mode 100644 index 0000000000..c33a6c9820 --- /dev/null +++ b/conf/svcomp-c2po3_join.json @@ -0,0 +1,154 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "symb_locks", + "region", + "thread", + "threadJoins", + "c2po", + "startState", + "taintPartialContexts" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + }, + "c2po": { + "askbase": true, + "precise_join": true, + "normal_form": false + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false, + "call": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": true, + "id": "enumerate", + "unknown": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "invariant_set" + ], + "invariant-types": [ + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": false, + "other": false, + "accessed": false, + "exact": true, + "exclude-vars": [ + "tmp\\(___[0-9]+\\)?", + "cond", + "RETURN", + "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", + ".*____CPAchecker_TMP_[0-9]+", + "__VERIFIER_assert__cond", + "__ksymtab_.*", + "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" + ] + } + }, + "pre": { + "enabled": false + } + } diff --git a/conf/svcomp-c2po4.json b/conf/svcomp-c2po4.json new file mode 100644 index 0000000000..7838279e8d --- /dev/null +++ b/conf/svcomp-c2po4.json @@ -0,0 +1,154 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "symb_locks", + "region", + "thread", + "threadJoins", + "c2po", + "startState", + "taintPartialContexts" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + }, + "c2po": { + "askbase": true, + "precise_join": false, + "normal_form": false + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false, + "call": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": true, + "id": "enumerate", + "unknown": false + }, + "yaml": { + "enabled": true, + "format-version": "2.0", + "entry-types": [ + "invariant_set" + ], + "invariant-types": [ + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": false, + "other": false, + "accessed": false, + "exact": true, + "exclude-vars": [ + "tmp\\(___[0-9]+\\)?", + "cond", + "RETURN", + "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", + ".*____CPAchecker_TMP_[0-9]+", + "__VERIFIER_assert__cond", + "__ksymtab_.*", + "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" + ] + } + }, + "pre": { + "enabled": false + } + } From 1dc5301d7ef091a4af44ebdb45737fa3c10be5eb Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 31 Jul 2024 13:23:59 +0200 Subject: [PATCH 286/323] fixed lazy computation and added timings.wrap --- src/cdomains/c2poDomain.ml | 2 ++ src/cdomains/congruenceClosure.ml | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index b61f8a27fa..ca8a7d71c1 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -62,6 +62,8 @@ module D = struct if M.tracing then M.trace "c2po-normal-form" "COMPUTING EQUAL"; if GobConfig.get_bool "ana.c2po.normal_form" then equal_normal_form a b else equal_standard a b + let equal a b = Timing.wrap "c2po-equal" (equal a) b + let empty () = Some init_cc let init () = empty () diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c25ef7f5fc..d87215fc69 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -556,6 +556,8 @@ module C2PO = struct (* compute the minimal representative of all remaining edges *) in update_min_repr (uf, set, map) min_representatives queue + let compute_minimal_representatives a = Timing.wrap "c2po-compute-min-repr" compute_minimal_representatives a + (** Computes the initial map of minimal representatives. It maps each element `e` in the set to `(e, 0)`. *) let initial_minimal_representatives set = @@ -663,8 +665,8 @@ module C2PO = struct match cc with | None -> None | Some cc -> - let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in Some {cc with normal_form = lazy( + let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) )} From d46b4b77e69b6951b9f6de809799b5abeccbd4d8 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 1 Aug 2024 14:53:33 +0200 Subject: [PATCH 287/323] added a widen operator for the join with automaton as described in my masters thesis --- src/cdomains/c2poDomain.ml | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index ca8a7d71c1..4b2d189e13 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -100,6 +100,17 @@ module D = struct let join a b = Timing.wrap "join" (join a) b + let widen_automata a' b' = + (* we calculate the join and then restrict to the term set of a' *) + match a',b' with + | None, b -> b + | a, None -> a + | Some a, Some b -> + match join (Some a) (Some b) with + | None -> None + | Some join_result -> + remove_terms (fun t -> not @@ SSet.mem t a.set) join_result + let widen_eq_classes a' b' = let res = match a',b' with @@ -121,7 +132,9 @@ module D = struct reset_normal_form res let widen a b = if M.tracing then M.trace "c2po-widen" "WIDEN\n"; - if GobConfig.get_bool "ana.c2po.precise_join" then join a b(*TODO*) else widen_eq_classes a b + if GobConfig.get_bool "ana.c2po.precise_join" then + widen_automata a b + else widen_eq_classes a b let meet a' b' = if M.tracing then M.trace "c2po-meet" "MEET x= %s; y=%s" (show a') (show b'); From f58d2bdfc919f569cf250ed654b74d18bcf9eb80 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Fri, 2 Aug 2024 11:46:28 +0200 Subject: [PATCH 288/323] fixed bug in normal form --- src/cdomains/c2poDomain.ml | 14 ++++++++------ src/cdomains/congruenceClosure.ml | 7 ++++--- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 4b2d189e13..d0adae8b95 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -81,7 +81,7 @@ module D = struct | None, b -> b | a, None -> a | Some a, Some b -> - if exactly_equal a b then + if exactly_equal a b then a' else (if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" @@ -89,11 +89,12 @@ module D = struct let cc = fst(join_cc_function a b) in let cmap1, cmap2 = fst(Disequalities.comp_map a.uf), fst(Disequalities.comp_map b.uf) in let cc = Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc in - Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2)) + let cc = Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2) + in reset_normal_form cc) in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); - reset_normal_form res + res let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then (if M.tracing then M.trace "c2po-join" "Join Automaton"; join a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join a b join_eq_no_automata) @@ -109,7 +110,7 @@ module D = struct match join (Some a) (Some b) with | None -> None | Some join_result -> - remove_terms (fun t -> not @@ SSet.mem t a.set) join_result + reset_normal_form @@ remove_terms (fun t -> not @@ SSet.mem t a.set) join_result let widen_eq_classes a' b' = let res = @@ -125,11 +126,12 @@ module D = struct let cc = fst(widen_eq_no_automata a b) in let cmap1, cmap2 = fst(Disequalities.comp_map a.uf), fst(Disequalities.comp_map b.uf) in let cc = Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2) in - Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc) + let cc = Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc in + reset_normal_form cc) in if M.tracing then M.tracel "c2po-join" "WIDEN. WIDEN: %s\n" (show_all res); - reset_normal_form res + res let widen a b = if M.tracing then M.trace "c2po-widen" "WIDEN\n"; if GobConfig.get_bool "ana.c2po.precise_join" then diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index d87215fc69..37b5bf036c 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -536,7 +536,7 @@ module C2PO = struct - The map with the minimal representatives - The union find tree. This might have changed because of path compression. *) let compute_minimal_representatives (uf, set, map) = - if M.tracing then M.trace "c2po" "compute_minimal_representatives\n"; + if M.tracing then M.trace "c2po-normal-form" "compute_minimal_representatives\n"; let atoms = SSet.get_atoms set in (* process all atoms in increasing order *) let atoms = @@ -667,10 +667,11 @@ module C2PO = struct | Some cc -> Some {cc with normal_form = lazy( let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in - get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + if M.tracing then M.trace "c2po-min-repr" "COMPUTE MIN REPR: %s" (MRMap.show_min_rep min_repr); + let conj = get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + in if M.tracing then M.trace "c2po-equal" "COMPUTE NORMAL FORM: %s" (show_conj conj); conj )} - let show_all x = "Normal form:\n" ^ show_conj((get_conjunction x)) ^ "Union Find partition:\n" ^ From 1653e28ee7076e30223c5391ca81b80726c4909a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 5 Aug 2024 20:04:53 +0200 Subject: [PATCH 289/323] fix invalid_widen bug --- src/analyses/c2poAnalysis.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index e124fa1931..b140c2819c 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -132,7 +132,7 @@ struct let t = D.remove_may_equal_terms ask s lterm ctx.local in begin match desc.special exprs with | Malloc _ | Calloc _ | Alloca _ -> - reset_normal_form @@ add_block_diseqs t lterm + add_block_diseqs t lterm | _ -> t end) with (T.UnsupportedCilExpression _) -> D.top () @@ -143,7 +143,7 @@ struct ctx.local else branch ctx exp true - | _ -> t + | _ -> reset_normal_form t let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } From 6ba1cc77a498d68ad0851cd95b0d02456c9846ea Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 09:39:33 +0200 Subject: [PATCH 290/323] outsource variable handling --- src/analyses/c2poAnalysis.ml | 12 +++++------- src/analyses/startStateAnalysis.ml | 8 +------- src/cdomains/congruenceClosure.ml | 4 ++-- src/cdomains/duplicateVars.ml | 28 ++++++++++++++++++++++++++++ src/goblint_lib.ml | 1 + 5 files changed, 37 insertions(+), 16 deletions(-) create mode 100644 src/cdomains/duplicateVars.ml diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index b140c2819c..2b1c6a2d8c 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -7,6 +7,7 @@ open CongruenceClosure open C2PO open Batteries open SingleThreadedLifter +open DuplicateVars.Var module Spec = struct @@ -76,7 +77,7 @@ struct t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable @@ MayBeEqual.dummy_varinfo lval_t + D.remove_terms_containing_variable @@ dummy_varinfo lval_t | exception (T.UnsupportedCilExpression _) -> if M.tracing then M.trace "c2po-invalidate" "INVALIDATE lval: %a" d_lval lval; D.top () @@ -145,9 +146,6 @@ struct branch ctx exp true | _ -> reset_normal_form t - let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } - let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } - (*First all local variables of the function are duplicated (by negating their ID), then we remember the value of each local variable at the beginning of the function by using the analysis startState. This way we can infer the relations between the @@ -156,7 +154,7 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) let reachable_variables = f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args @@ -168,7 +166,7 @@ struct let remove_out_of_scope_vars t f = let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in - D.remove_terms_containing_variables (MayBeEqual.return_varinfo (TVoid [])::local_vars @ duplicated_vars) t + D.remove_terms_containing_variables (return_varinfo (TVoid [])::local_vars @ duplicated_vars) t (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) @@ -185,7 +183,7 @@ struct let local = D.remove_tainted_terms (ask_of_ctx ctx) tainted state_with_assignments in let t = D.meet local t in let t = reset_normal_form @@ remove_out_of_scope_vars t f in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (MayBeEqual.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t (*ctx.local is after combine_env, t callee*) let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index efd2e839a2..c9d2d36eae 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -4,7 +4,7 @@ open GoblintCil open Batteries open Analyses - +open DuplicateVars.Var (*First all parameters (=formals) of the function are duplicated (by negating their ID), then we remember the value of each local variable at the beginning of the function @@ -20,12 +20,6 @@ struct include Analyses.IdentitySpec - - let duplicated_variable var = { var with vid = - var.vid - 4; vname = "wrpointer__" ^ var.vname ^ "'" } - let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:11 @@ String.rchop var.vname } - let return_varinfo = {dummyFunDec.svar with vid=(-2);vname="wrpointer__@return"} - let is_wrpointer_ghost_variable x = x.vid < 0 && String.starts_with x.vname "wrpointer__" - let ask_may_point_to (ask: Queries.ask) exp = match ask.f (MayPointTo exp) with | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top() diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 37b5bf036c..db9afa089b 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1240,11 +1240,11 @@ module MayBeEqual = struct open C2PO module AD = Queries.AD - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} + open DuplicateVars.Var + let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="c2po__@return"} let return_var var = T.aux_term_of_varinfo (return_varinfo var) let return_lval var = Lval (Var (return_varinfo var), NoOffset) diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml new file mode 100644 index 0000000000..3b50496c61 --- /dev/null +++ b/src/cdomains/duplicateVars.ml @@ -0,0 +1,28 @@ +open CilType +open GoblintCil +open Batteries +open GoblintCil + +module Var = struct + let equal_typ _ _ = true + let hash_typ _ = 0 + let compare_typ _ _ = 0 + + type t = AssignAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) + | ReturnAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) + | VarNormal of Varinfo.t + | ShadowVar of Varinfo.t [@@deriving eq,ord,hash] + + let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} + let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="c2po__@return"} + + let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } + let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:6 @@ String.rchop var.vname } + + let is_wrpointer_ghost_variable x = x.vid < 0 && String.starts_with x.vname "c2po__" + let to_varinfo v = match v with + | AssignAux t -> dummy_varinfo t + | ReturnAux t -> return_varinfo t + | VarNormal v -> v + | ShadowVar v -> duplicated_variable v +end diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 3ce71b1fad..cedfc55979 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -402,6 +402,7 @@ module CilType = CilType module Cilfacade = Cilfacade module CilLocation = CilLocation module RichVarinfo = RichVarinfo +module DuplicateVars = DuplicateVars module CilCfg = CilCfg module LoopUnrolling = LoopUnrolling From d963273f3d32952c2738e3f3987fe7c7900e51db Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 11:12:24 +0200 Subject: [PATCH 291/323] make everything compatible with the new duplicated vars --- src/analyses/c2poAnalysis.ml | 39 ++++++++++++++----------- src/cdomains/c2poDomain.ml | 10 +++---- src/cdomains/congruenceClosure.ml | 10 +++---- src/cdomains/duplicateVars.ml | 13 +++++++-- src/cdomains/unionFind.ml | 47 +++++++++++++++++-------------- 5 files changed, 69 insertions(+), 50 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 2b1c6a2d8c..3762ab43ac 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -64,28 +64,33 @@ struct end | _ -> Result.top q - let assign_lval t ask lval expr = + let assign_term t ask lterm expr lval_t = (* ignore assignments to values that are not 64 bits *) - let lval_t = typeOfLval lval in - match T.get_element_size_in_bits lval_t, T.of_lval ask lval, T.of_cil ask expr with + match T.get_element_size_in_bits lval_t, T.of_cil ask expr with (* Indefinite assignment *) - | s, lterm, (None, _) -> D.remove_may_equal_terms ask s lterm t + | s, (None, _) -> D.remove_may_equal_terms ask s lterm t (* Definite assignment *) - | s, lterm, (Some term, Some offset) -> + | s, (Some term, Some offset) -> let dummy_var = MayBeEqual.dummy_var lval_t in if M.tracing then M.trace "c2po-assign" "assigning: var: %s; expr: %s + %s. \nTo_cil: lval: %a; expr: %a\n" (T.show lterm) (T.show term) (Z.to_string offset) d_exp (T.to_cil lterm) d_exp (T.to_cil term); t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable @@ dummy_varinfo lval_t - | exception (T.UnsupportedCilExpression _) -> if M.tracing then M.trace + D.remove_terms_containing_variable @@ AssignAux lval_t + | _ -> (* this is impossible *) D.top () + + let assign_lval t ask lval expr = + let lval_t = typeOfLval lval in + match T.of_lval ask lval with + | lterm -> assign_term t ask lterm expr lval_t + | exception (T.UnsupportedCilExpression _) -> + (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. + We have to forget all the information we had. + This should almost never happen. + Except if the left hand side is a complicated expression like myStruct.field1[i]->field2[z+k], and Goblint can't infer the offset.*) + if M.tracing then M.trace "c2po-invalidate" "INVALIDATE lval: %a" d_lval lval; D.top () - (* the assigned variables couldn't be parsed, so we don't know which addresses were written to. - We have to forget all the information we had. - This should almost never happen. - Except if the left hand side is a complicated expression like myStruct.field1[i]->field2[z+k], and Goblint can't infer the offset.*) - | _ -> D.top () let assign ctx lval expr = let res = reset_normal_form @@ assign_lval ctx.local (ask_of_ctx ctx) lval expr in @@ -152,12 +157,12 @@ struct local variables of the caller and the pointers that were modified by the function. *) let enter ctx var_opt f args = (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (duplicated_variable v), T.term_of_varinfo v, Z.zero)) f.sformals) in + let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (ShadowVar v), T.term_of_varinfo (NormalVar v), Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) let reachable_variables = - f.sformals @ f.slocals @ List.map duplicated_variable f.sformals @ reachable_from_args ctx args + from_varinfo (f.sformals @ f.slocals @ reachable_from_args ctx args) f.sformals in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); @@ -166,7 +171,7 @@ struct let remove_out_of_scope_vars t f = let local_vars = f.sformals @ f.slocals in let duplicated_vars = List.map duplicated_variable f.sformals in - D.remove_terms_containing_variables (return_varinfo (TVoid [])::local_vars @ duplicated_vars) t + D.remove_terms_containing_variables (ReturnAux (TVoid [])::from_varinfo local_vars duplicated_vars) t (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) @@ -174,7 +179,7 @@ struct let og_t = t in (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) exp var.vtype) ctx.local arg_assigns in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = ask.f (MayBeTainted) @@ -189,7 +194,7 @@ struct let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_lval st (ask_of_ctx ctx) (Var (duplicated_variable var), NoOffset) exp) ctx.local arg_assigns in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) exp var.vtype) ctx.local arg_assigns in let t = D.meet state_with_assignments t in let t = match var_opt with | None -> t diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index d0adae8b95..c782c79c2d 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -5,7 +5,7 @@ open GoblintCil open CongruenceClosure open C2PO module M = Messages -module Var = CilType.Varinfo +open DuplicateVars module D = struct @@ -192,7 +192,7 @@ module D = struct It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = - if M.tracing then M.trace "c2po" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); + if M.tracing then M.trace "c2po" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^Var.show v) "" vars); Option.bind cc (remove_terms (T.contains_variable vars)) (** Remove terms from the data structure. @@ -200,8 +200,8 @@ module D = struct except the global vars are also keeped (when vstorage = static), while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = - if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^v.vname) "" vars); - Option.bind cc (remove_terms (fun t -> (not (T.get_var t).vglob) && not (T.contains_variable vars t))) + if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^Var.show v) "" vars); + Option.bind cc (remove_terms (fun t -> (not (Var.to_varinfo (T.get_var t)).vglob) && not (T.contains_variable vars t))) (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) @@ -221,5 +221,5 @@ module D = struct let remove_vars_not_in_scope scope cc = Option.bind cc (fun cc -> remove_terms (fun t -> let var = T.get_var t in - InvariantCil.var_is_tmp var || not (InvariantCil.var_is_in_scope scope var)) cc) + InvariantCil.var_is_tmp (Var.to_varinfo var) || not (InvariantCil.var_is_in_scope scope (Var.to_varinfo var))) cc) end diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index db9afa089b..bbda54398f 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1242,11 +1242,11 @@ module MayBeEqual = struct module AD = Queries.AD open DuplicateVars.Var - let dummy_var var = T.aux_term_of_varinfo (dummy_varinfo var) - let dummy_lval var = Lval (Var (dummy_varinfo var), NoOffset) + let dummy_var typ = T.aux_term_of_varinfo (AssignAux typ) + let dummy_lval typ = Lval (Var (to_varinfo (AssignAux typ)), NoOffset) - let return_var var = T.aux_term_of_varinfo (return_varinfo var) - let return_lval var = Lval (Var (return_varinfo var), NoOffset) + let return_var typ = T.aux_term_of_varinfo (ReturnAux typ) + let return_lval typ = Lval (Var (to_varinfo (ReturnAux typ)), NoOffset) let ask_may_point_to (ask: Queries.ask) exp = match ask.f (MayPointTo exp) with @@ -1257,7 +1257,7 @@ module MayBeEqual = struct let equal_terms = if TMap.mem term cc.uf then let comp = Disequalities.comp_t cc.uf term in let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (T.get_var t).vid > 0 in + T.is_ptr_type (T.type_of_term t) && (to_varinfo (T.get_var t)).vid > 0 in List.filter valid_term comp else [(term,Z.zero)] in diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index 3b50496c61..fcfd8a843a 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -10,7 +10,7 @@ module Var = struct type t = AssignAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) | ReturnAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) - | VarNormal of Varinfo.t + | NormalVar of Varinfo.t | ShadowVar of Varinfo.t [@@deriving eq,ord,hash] let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} @@ -23,6 +23,15 @@ module Var = struct let to_varinfo v = match v with | AssignAux t -> dummy_varinfo t | ReturnAux t -> return_varinfo t - | VarNormal v -> v + | NormalVar v -> v | ShadowVar v -> duplicated_variable v + + let from_varinfo normal duplicated = + List.map (fun v -> NormalVar v) normal @ List.map (fun v -> ShadowVar v) duplicated + + let show v = match v with + | AssignAux t -> "AuxAssign" + | ReturnAux t -> "AuxReturn" + | NormalVar v -> v.vname + | ShadowVar v -> "c2po__" ^ v.vname ^ "'" end diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 66910850f2..061d0a536d 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -1,7 +1,7 @@ open Batteries open GoblintCil -module Var = CilType.Varinfo +open DuplicateVars module M = Messages exception Unsat @@ -78,9 +78,6 @@ module T = struct let rec get_size_in_bits typ = match typ with | TArray (typ, _, _) -> (* we treat arrays like pointers *) get_size_in_bits (TPtr (typ,[])) - (* | TComp (compinfo, _) -> - if List.is_empty compinfo.cfields then Z.zero else - get_size_in_bits (List.first compinfo.cfields).ftype *) | _ -> match Z.of_int (bitsSizeOf typ) with | exception GoblintCil__Cil.SizeOfError (msg,_) when msg ="abstract type"-> Z.one | exception GoblintCil__Cil.SizeOfError (msg,_) -> @@ -121,6 +118,7 @@ module T = struct (** Returns true if the second parameter contains one of the variables defined in the list "variables". *) let contains_variable variables term = List.mem_cmp Var.compare (get_var term) variables + (** Use query EvalInt for an expression. *) let eval_int (ask:Queries.ask) exp = match Cilfacade.get_ikind_exp exp with | exception Invalid_argument _ -> raise (UnsupportedCilExpression "non-constant value") @@ -140,8 +138,8 @@ module T = struct | i -> Some i | exception (UnsupportedCilExpression _) -> None - (*returns Some type for a pointer to a type - and None if the result is not a pointer*) + (** Returns Some type for a pointer to a type + and None if the result is not a pointer. *) let rec type_of_element typ = match typ with | TArray (typ, _, _) -> type_of_element typ @@ -176,12 +174,17 @@ module T = struct | TPtr _ -> true | _ -> false + let rec is_float = function + | TNamed (typinfo, _) -> is_float typinfo.ttype + | TFloat _ -> true + | _ -> false + let aux_term_of_varinfo vinfo = - Aux (vinfo, Lval (Var vinfo, NoOffset)) + Aux (vinfo, Lval (Var (Var.to_varinfo vinfo), NoOffset)) let term_of_varinfo vinfo = - if is_struct_type vinfo.vtype || vinfo.vaddrof then - Deref (Addr vinfo, Z.zero, Lval (Var vinfo, NoOffset)) + if is_struct_type (Var.to_varinfo vinfo).vtype || (Var.to_varinfo vinfo).vaddrof then + Deref (Addr vinfo, Z.zero, Lval (Var (Var.to_varinfo vinfo), NoOffset)) else aux_term_of_varinfo vinfo @@ -228,12 +231,12 @@ module T = struct let type_of_term = function - | Addr v -> TPtr (v.vtype, []) + | Addr v -> TPtr ((Var.to_varinfo v).vtype, []) | Aux (_, exp) | Deref (_, _, exp) -> typeOf exp let to_cil = function - | (Addr v) -> AddrOf (Var v, NoOffset) + | (Addr v) -> AddrOf (Var (Var.to_varinfo v), NoOffset) | Aux (_, exp) | (Deref (_, _, exp)) -> exp let default_int_type = ILong @@ -279,10 +282,9 @@ module T = struct else raise (UnsupportedCilExpression "Field on a non-compound") with | Cilfacade.TypeOfError _ -> raise (UnsupportedCilExpression "typeOf error") - let is_float = function - | TFloat _ -> true - | _ -> false - + (** Returns true if the Cil expression represents a 64 bit data type, + which is not a float. So it must be either a pointer or an integer + that has the same size as a pointer.*) let check_valid_pointer term = match typeOf term with (* we want to make sure that the expression is valid *) | exception GoblintCil__Errormsg.Error -> false @@ -290,9 +292,12 @@ module T = struct if get_size_in_bits typ <> bitsSizeOfPtr () || is_float typ then false else true + (** Only keeps the variables that are actually pointers (or 64-bit integers). *) let filter_valid_pointers = List.filter (function | Equal(t1,t2,_)| Nequal(t1,t2,_) |BlNequal(t1,t2)-> check_valid_pointer (to_cil t1) && check_valid_pointer (to_cil t2)) + (** Get a Cil expression that is equivalent to *(exp + offset), + by taking into account type correctness.*) let dereference_exp exp offset = if M.tracing then M.trace "c2po-deref" "exp: %a, offset: %s" d_exp exp (Z.to_string offset); let res = @@ -336,7 +341,7 @@ module T = struct | AlignOfE _ -> raise (UnsupportedCilExpression "unsupported AlignOf") | Lval lval -> Some (of_lval ask lval), Z.zero | StartOf lval -> Some (of_lval ask lval), Z.zero - | AddrOf (Var var, NoOffset) -> Some (Addr var), Z.zero + | AddrOf (Var var, NoOffset) -> Some (Addr (Var.NormalVar var)), Z.zero | AddrOf (Mem exp, NoOffset) -> of_cil ask exp | UnOp (op,exp,typ) -> begin match op with | Neg -> let off = eval_int ask exp in None, Z.(-off) @@ -374,9 +379,9 @@ module T = struct and of_lval ask lval = let res = match lval with - | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr var) off var.vtype (Lval lval) + | (Var var, off) -> if is_struct_type var.vtype then of_offset ask (Addr (Var.NormalVar var)) off var.vtype (Lval lval) else - of_offset ask (term_of_varinfo var) off var.vtype (Lval lval) + of_offset ask (term_of_varinfo (Var.NormalVar var)) off var.vtype (Lval lval) | (Mem exp, off) -> begin match of_cil ask exp with | (Some term, offset) -> @@ -396,8 +401,6 @@ module T = struct | t -> M.trace "c2po-cil-conversion" "lval: %a --> %s\n" d_plainlval lval (show t)) ;res - (** Converts the negated expresion to a term if neg = true. - If neg = false then it simply converts the expression to a term. *) let rec of_cil_neg ask neg e = match e with | UnOp (op,exp,typ)-> begin match op with @@ -406,6 +409,8 @@ module T = struct end | _ -> if neg then raise (UnsupportedCilExpression "unsupported UnOp Neg") else of_cil ask e + (** Converts the negated expression to a term if neg = true. + If neg = false then it simply converts the expression to a term. *) let of_cil_neg ask neg e = match is_float (typeOf e) with | exception GoblintCil__Errormsg.Error | true -> None, None @@ -463,7 +468,7 @@ module T = struct (** `prop_of_cil e pos` parses the expression `e` (or `not e` if `pos = false`) and returns a list of length 1 with the parsed expresion or an empty list if - the expression can't be expressed with the data type `prop`. *) + the expression can't be expressed with the type `prop`. *) let rec prop_of_cil ask e pos = let e = Cil.constFold false e in match e with From ecb67da8a54db4588c8845a61d7934cfadf39868 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 11:12:49 +0200 Subject: [PATCH 292/323] replace wrpointer with c2po --- src/analyses/startStateAnalysis.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index c9d2d36eae..b0479ebfb0 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -1,5 +1,5 @@ (** Remembers the abstract address value of each parameter at the beginning of each function by adding a ghost variable for each parameter. - Used by the wrpointer anaylysis. *) + Used by the c2po anaylysis. *) open GoblintCil open Batteries @@ -32,10 +32,10 @@ struct If e is an unknown variable or an expression that is not simply a variable, then it returns top. *) let eval (ask: Queries.ask) (d: D.t) (exp: exp): Value.t = match exp with | Lval (Var x, NoOffset) -> begin match D.find_opt x d with - | Some v -> if M.tracing then M.trace "wrpointer-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v + | Some v -> if M.tracing then M.trace "c2po-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v | None -> Value.top() end - | AddrOf (Var x, NoOffset) -> if is_wrpointer_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "wrpointer-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() + | AddrOf (Var x, NoOffset) -> if is_wrpointer_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "c2po-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() | _ -> Value.top () let startcontext () = D.empty () From 6edd0ace461777466eb4a42f9e3d2ae92f3c4a4a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 11:49:04 +0200 Subject: [PATCH 293/323] fixed bugs. Needs to be tested --- src/analyses/c2poAnalysis.ml | 15 ++++++++------- src/analyses/startStateAnalysis.ml | 7 ++++--- src/cdomains/duplicateVars.ml | 2 +- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 3762ab43ac..09a952321f 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -64,9 +64,9 @@ struct end | _ -> Result.top q - let assign_term t ask lterm expr lval_t = + let assign_term t ask lterm rhs lval_t = (* ignore assignments to values that are not 64 bits *) - match T.get_element_size_in_bits lval_t, T.of_cil ask expr with + match T.get_element_size_in_bits lval_t, rhs with (* Indefinite assignment *) | s, (None, _) -> D.remove_may_equal_terms ask s lterm t (* Definite assignment *) @@ -93,7 +93,8 @@ struct D.top () let assign ctx lval expr = - let res = reset_normal_form @@ assign_lval ctx.local (ask_of_ctx ctx) lval expr in + let ask = (ask_of_ctx ctx) in + let res = reset_normal_form @@ assign_lval ctx.local ask lval (T.of_cil ask expr) in if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "None" res); res let branch ctx e pos = @@ -170,7 +171,7 @@ struct let remove_out_of_scope_vars t f = let local_vars = f.sformals @ f.slocals in - let duplicated_vars = List.map duplicated_variable f.sformals in + let duplicated_vars = f.sformals in D.remove_terms_containing_variables (ReturnAux (TVoid [])::from_varinfo local_vars duplicated_vars) t (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t @@ -179,7 +180,7 @@ struct let og_t = t in (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) exp var.vtype) ctx.local arg_assigns in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = ask.f (MayBeTainted) @@ -194,11 +195,11 @@ struct let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) exp var.vtype) ctx.local arg_assigns in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in let t = D.meet state_with_assignments t in let t = match var_opt with | None -> t - | Some var -> assign_lval t ask var (MayBeEqual.return_lval (typeOfLval var)) + | Some var -> assign_lval t ask var (Some (MayBeEqual.return_var (typeOfLval var)), Some Z.zero) in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); let t = reset_normal_form @@ remove_out_of_scope_vars t f diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index b0479ebfb0..8d59dcade7 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -35,7 +35,7 @@ struct | Some v -> if M.tracing then M.trace "c2po-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v | None -> Value.top() end - | AddrOf (Var x, NoOffset) -> if is_wrpointer_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "c2po-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() + | AddrOf (Var x, NoOffset) -> if is_c2po_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "c2po-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() | _ -> Value.top () let startcontext () = D.empty () @@ -52,8 +52,9 @@ struct let body ctx (f:fundec) = (* assign function parameters *) List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in - if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var (duplicated_variable var), NoOffset) Value.pretty value; - D.add (duplicated_variable var) value st) (D.empty()) f.sformals + let duplicated_var = to_varinfo (ShadowVar var) in + if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var duplicated_var, NoOffset) Value.pretty value; + D.add duplicated_var value st) (D.empty()) f.sformals end let _ = diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index fcfd8a843a..1d0248f484 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -19,7 +19,7 @@ module Var = struct let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:6 @@ String.rchop var.vname } - let is_wrpointer_ghost_variable x = x.vid < 0 && String.starts_with x.vname "c2po__" + let is_c2po_ghost_variable x = x.vid < 0 && String.starts_with x.vname "c2po__" let to_varinfo v = match v with | AssignAux t -> dummy_varinfo t | ReturnAux t -> return_varinfo t From 8efe09cb058c7b0c78fb3a08412698a33339daff Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 13:47:48 +0200 Subject: [PATCH 294/323] fix some things --- src/analyses/c2poAnalysis.ml | 2 +- src/analyses/startStateAnalysis.ml | 2 +- src/cdomains/congruenceClosure.ml | 7 +++---- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 09a952321f..76ec1b3436 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -122,7 +122,7 @@ struct | Some e -> assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e | None -> ctx.local - in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res + in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval_print (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res (** var_opt is the variable we assign to. It has type lval. v=malloc.*) let special ctx var_opt v exprs = diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 8d59dcade7..ce691c2699 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -35,7 +35,7 @@ struct | Some v -> if M.tracing then M.trace "c2po-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v | None -> Value.top() end - | AddrOf (Var x, NoOffset) -> if is_c2po_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "c2po-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() + | AddrOf (Var x, NoOffset) -> (*TODO will original_variable still work?*)if is_c2po_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "c2po-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() | _ -> Value.top () let startcontext () = D.empty () diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index bbda54398f..ca94415f51 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -2,7 +2,7 @@ include UnionFind open Batteries open GoblintCil -module Var = CilType.Varinfo +open DuplicateVars module M = Messages (** Quantitative congruence closure on terms *) @@ -1240,13 +1240,12 @@ module MayBeEqual = struct open C2PO module AD = Queries.AD - open DuplicateVars.Var + open Var let dummy_var typ = T.aux_term_of_varinfo (AssignAux typ) - let dummy_lval typ = Lval (Var (to_varinfo (AssignAux typ)), NoOffset) + let dummy_lval_print typ = Lval (Var (to_varinfo (AssignAux typ)), NoOffset) let return_var typ = T.aux_term_of_varinfo (ReturnAux typ) - let return_lval typ = Lval (Var (to_varinfo (ReturnAux typ)), NoOffset) let ask_may_point_to (ask: Queries.ask) exp = match ask.f (MayPointTo exp) with From e5613833116f0d51b65fc2dc6c6f9ba32d699635 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 14:45:25 +0200 Subject: [PATCH 295/323] add Var. --- src/analyses/c2poAnalysis.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 76ec1b3436..10bf8f8fcf 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -7,7 +7,7 @@ open CongruenceClosure open C2PO open Batteries open SingleThreadedLifter -open DuplicateVars.Var +open DuplicateVars module Spec = struct @@ -160,10 +160,10 @@ struct (* add duplicated variables, and set them equal to the original variables *) let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (ShadowVar v), T.term_of_varinfo (NormalVar v), Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); + if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) let reachable_variables = - from_varinfo (f.sformals @ f.slocals @ reachable_from_args ctx args) f.sformals + Var.from_varinfo (f.sformals @ f.slocals @ reachable_from_args ctx args) f.sformals in let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); @@ -172,7 +172,7 @@ struct let remove_out_of_scope_vars t f = let local_vars = f.sformals @ f.slocals in let duplicated_vars = f.sformals in - D.remove_terms_containing_variables (ReturnAux (TVoid [])::from_varinfo local_vars duplicated_vars) t + D.remove_terms_containing_variables (ReturnAux (TVoid [])::Var.from_varinfo local_vars duplicated_vars) t (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t expr funktionsaufruf*) @@ -189,7 +189,7 @@ struct let local = D.remove_tainted_terms (ask_of_ctx ctx) tainted state_with_assignments in let t = D.meet local t in let t = reset_normal_form @@ remove_out_of_scope_vars t f in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t (*ctx.local is after combine_env, t callee*) let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = From b0ce43159740131db051f0979863fc8a130eb134 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 14:45:46 +0200 Subject: [PATCH 296/323] I think this is not necessary --- src/analyses/startStateAnalysis.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index ce691c2699..30402469cb 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -35,7 +35,6 @@ struct | Some v -> if M.tracing then M.trace "c2po-tainted" "QUERY %a : res = %a\n" d_exp exp AD.pretty v;v | None -> Value.top() end - | AddrOf (Var x, NoOffset) -> (*TODO will original_variable still work?*)if is_c2po_ghost_variable x then (let res = get_value ask (AddrOf (Var (original_variable x), NoOffset)) in if M.tracing then M.trace "c2po-tainted" "QUERY %a, id: %d : res = %a\n" d_exp exp x.vid AD.pretty res;res) else Value.top() | _ -> Value.top () let startcontext () = D.empty () From cfd155e4d3c2c63fa97c7dc9863b87f26baa1ca5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 14:46:11 +0200 Subject: [PATCH 297/323] use the other method for variable duplication --- src/cdomains/duplicateVars.ml | 45 ++++++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index 1d0248f484..7f56ccbe27 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -3,7 +3,7 @@ open GoblintCil open Batteries open GoblintCil -module Var = struct +module VarType = struct let equal_typ _ _ = true let hash_typ _ = 0 let compare_typ _ _ = 0 @@ -13,19 +13,6 @@ module Var = struct | NormalVar of Varinfo.t | ShadowVar of Varinfo.t [@@deriving eq,ord,hash] - let dummy_varinfo typ: varinfo = {dummyFunDec.svar with vid=(-1);vtype=typ;vname="c2po__@dummy"} - let return_varinfo typ = {dummyFunDec.svar with vtype=typ;vid=(-2);vname="c2po__@return"} - - let duplicated_variable var = { var with vid = - var.vid - 4; vname = "c2po__" ^ var.vname ^ "'" } - let original_variable var = { var with vid = - (var.vid + 4); vname = String.lchop ~n:6 @@ String.rchop var.vname } - - let is_c2po_ghost_variable x = x.vid < 0 && String.starts_with x.vname "c2po__" - let to_varinfo v = match v with - | AssignAux t -> dummy_varinfo t - | ReturnAux t -> return_varinfo t - | NormalVar v -> v - | ShadowVar v -> duplicated_variable v - let from_varinfo normal duplicated = List.map (fun v -> NormalVar v) normal @ List.map (fun v -> ShadowVar v) duplicated @@ -34,4 +21,34 @@ module Var = struct | ReturnAux t -> "AuxReturn" | NormalVar v -> v.vname | ShadowVar v -> "c2po__" ^ v.vname ^ "'" + + let name_varinfo v = match v with + | AssignAux t -> "AuxAssign" + | ReturnAux t -> "AuxReturn" + | NormalVar v -> string_of_int v.vid + | ShadowVar v -> "c2po__" ^ string_of_int v.vid ^ "'" + + + (* Description that gets appended to the varinfo-name in user output. *) + let describe_varinfo (var: varinfo) v = + (* let loc = UpdateCil.getLoc node in + CilType.Location.show loc *) + show v +end + +module VarVarinfoMap = RichVarinfo.BiVarinfoMap.Make(VarType) + + +module Var = +struct + include VarType + let dummy_varinfo typ: varinfo = VarVarinfoMap.to_varinfo (AssignAux typ) + let return_varinfo typ = VarVarinfoMap.to_varinfo (ReturnAux typ) + let to_varinfo v = let var = VarVarinfoMap.to_varinfo v in + match v with + | AssignAux t -> {var with vtype = t} + | ReturnAux t -> {var with vtype = t} + | NormalVar v -> v + | ShadowVar v -> {v with vid = var.vid} + end From c28f503b41397ed86c5d05a146de169368f17092 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 15:58:38 +0200 Subject: [PATCH 298/323] rename shadow to duplicated --- src/analyses/c2poAnalysis.ml | 6 +++--- src/analyses/startStateAnalysis.ml | 2 +- src/cdomains/duplicateVars.ml | 13 ++++++++----- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 10bf8f8fcf..6a09a49b6c 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -158,7 +158,7 @@ struct local variables of the caller and the pointers that were modified by the function. *) let enter ctx var_opt f args = (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (ShadowVar v), T.term_of_varinfo (NormalVar v), Z.zero)) f.sformals) in + let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (DuplicVar v), T.term_of_varinfo (NormalVar v), Z.zero)) f.sformals) in let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); (* remove callee vars that are not reachable and not global *) @@ -180,7 +180,7 @@ struct let og_t = t in (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (DuplicVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); (*remove all variables that were tainted by the function*) let tainted = ask.f (MayBeTainted) @@ -195,7 +195,7 @@ struct let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (ShadowVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (DuplicVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in let t = D.meet state_with_assignments t in let t = match var_opt with | None -> t diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 30402469cb..2964fe114d 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -51,7 +51,7 @@ struct let body ctx (f:fundec) = (* assign function parameters *) List.fold_left (fun st var -> let value = get_value (ask_of_ctx ctx) (Lval (Var var, NoOffset)) in - let duplicated_var = to_varinfo (ShadowVar var) in + let duplicated_var = to_varinfo (DuplicVar var) in if M.tracing then M.trace "startState" "added value: var: %a; value: %a" d_lval (Var duplicated_var, NoOffset) Value.pretty value; D.add duplicated_var value st) (D.empty()) f.sformals end diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index 7f56ccbe27..0dcc92596b 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -3,6 +3,9 @@ open GoblintCil open Batteries open GoblintCil +(** Variable Type used by the C-2PO Analysis. +It contains normal variables with a varinfo as well as auxiliary variables for +assignment and return and duplicated variables for remembering the value of variables at the beginning of a function. *) module VarType = struct let equal_typ _ _ = true let hash_typ _ = 0 @@ -11,22 +14,22 @@ module VarType = struct type t = AssignAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) | ReturnAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) | NormalVar of Varinfo.t - | ShadowVar of Varinfo.t [@@deriving eq,ord,hash] + | DuplicVar of Varinfo.t [@@deriving eq,ord,hash] let from_varinfo normal duplicated = - List.map (fun v -> NormalVar v) normal @ List.map (fun v -> ShadowVar v) duplicated + List.map (fun v -> NormalVar v) normal @ List.map (fun v -> DuplicVar v) duplicated let show v = match v with | AssignAux t -> "AuxAssign" | ReturnAux t -> "AuxReturn" | NormalVar v -> v.vname - | ShadowVar v -> "c2po__" ^ v.vname ^ "'" + | DuplicVar v -> "c2po__" ^ v.vname ^ "'" let name_varinfo v = match v with | AssignAux t -> "AuxAssign" | ReturnAux t -> "AuxReturn" | NormalVar v -> string_of_int v.vid - | ShadowVar v -> "c2po__" ^ string_of_int v.vid ^ "'" + | DuplicVar v -> "c2po__" ^ string_of_int v.vid ^ "'" (* Description that gets appended to the varinfo-name in user output. *) @@ -49,6 +52,6 @@ struct | AssignAux t -> {var with vtype = t} | ReturnAux t -> {var with vtype = t} | NormalVar v -> v - | ShadowVar v -> {v with vid = var.vid} + | DuplicVar v -> {v with vid = var.vid} end From d9de485779cc89568b9731952ddfde7936431893 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 15:58:51 +0200 Subject: [PATCH 299/323] fix indentation --- src/cdomains/duplicateVars.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index 0dcc92596b..94f245236d 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -4,8 +4,8 @@ open Batteries open GoblintCil (** Variable Type used by the C-2PO Analysis. -It contains normal variables with a varinfo as well as auxiliary variables for -assignment and return and duplicated variables for remembering the value of variables at the beginning of a function. *) + It contains normal variables with a varinfo as well as auxiliary variables for + assignment and return and duplicated variables for remembering the value of variables at the beginning of a function. *) module VarType = struct let equal_typ _ _ = true let hash_typ _ = 0 From 85ad21de29310cfa25eb8ef5b92c446407b28d44 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 16:49:34 +0200 Subject: [PATCH 300/323] remove some unused functions and add some comments --- src/cdomains/congruenceClosure.ml | 13 ----------- src/cdomains/duplicateVars.ml | 5 ++-- src/cdomains/unionFind.ml | 38 ++++++++----------------------- 3 files changed, 11 insertions(+), 45 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index ca94415f51..8c9c2f1bc6 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -80,11 +80,6 @@ module C2PO = struct | None -> false | Some set -> TSet.mem v' set - let filter_if (map:t) p = - TMap.filter_map (fun _ t_set -> - let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) map - let filter_map f (diseq:t) = TMap.filter_map (fun _ s -> let set = TSet.filter_map f s in @@ -361,14 +356,6 @@ module C2PO = struct List.fold_left (fun s (v,z,v',r) -> s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " --> " ^ T.show v^ "+"^ Z.to_string z ^ "\n") "" clist - - let filter_if map p = - TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ t_set -> let filtered_set = TSet.filter p t_set in - if TSet.is_empty filtered_set then None else Some filtered_set) zmap - in if ZMap.is_empty zmap then None else Some zmap) map - let filter_map f (diseq:t) = TMap.filter_map (fun _ zmap -> diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index 94f245236d..8ce0d7b90e 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -7,6 +7,8 @@ open GoblintCil It contains normal variables with a varinfo as well as auxiliary variables for assignment and return and duplicated variables for remembering the value of variables at the beginning of a function. *) module VarType = struct + (* the hash/compare values should not depend on the type. + But they have to be defined even though they are not used, for some reason.*) let equal_typ _ _ = true let hash_typ _ = 0 let compare_typ _ _ = 0 @@ -31,11 +33,8 @@ module VarType = struct | NormalVar v -> string_of_int v.vid | DuplicVar v -> "c2po__" ^ string_of_int v.vid ^ "'" - (* Description that gets appended to the varinfo-name in user output. *) let describe_varinfo (var: varinfo) v = - (* let loc = UpdateCil.getLoc node in - CilType.Location.show loc *) show v end diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 061d0a536d..031667962e 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -142,6 +142,7 @@ module T = struct and None if the result is not a pointer. *) let rec type_of_element typ = match typ with + | TNamed (typinfo, _) -> type_of_element typinfo.ttype | TArray (typ, _, _) -> type_of_element typ | TPtr (typ, _) -> Some typ | _ -> None @@ -188,6 +189,8 @@ module T = struct else aux_term_of_varinfo vinfo + (** Convert a Cil offset to an integer offset. + Copied from memOutOfBounds.ml. *) let cil_offs_to_idx (ask: Queries.ask) offs typ = (* TODO: Some duplication with convert_offset in base.ml and cil_offs_to_idx in memOutOfBounds.ml, unclear how to immediately get more reuse *) @@ -218,6 +221,8 @@ module T = struct in PreValueDomain.Offs.to_index ?typ:(Some (convert_type typ)) (convert_offset offs) + (** Convert an offset to an integer of Z, if posible. + Otherwise, this throws UnsupportedCilExpression. *) let z_of_offset ask offs typ = match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i @@ -225,7 +230,8 @@ module T = struct | exception (SizeOfError _) -> if M.tracing then M.trace "c2po-invalidate" "REASON: unknown offset"; raise (UnsupportedCilExpression "unknown offset") - let can_be_dereferenced = function + let rec can_be_dereferenced = function + | TNamed (typinfo, _) -> can_be_dereferenced typinfo.ttype | TPtr _| TArray _| TComp _ -> true | _ -> false @@ -260,6 +266,7 @@ module T = struct BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) in if M.tracing then M.trace "c2po-2cil" "exp: %a; offset: %s; res: %a" d_exp cil_t (Z.to_string off) d_exp res;res + (** Returns the integer offset of a field of a struct. *) let get_field_offset finfo = match IntDomain.IntDomTuple.to_int (PreValueDomain.Offs.to_index (`Field (finfo, `NoOffset))) with | Some i -> i | None -> raise (UnsupportedCilExpression "unknown offset") @@ -566,16 +573,6 @@ module UnionFind = struct | None -> true | Some (parent_t, _) -> T.equal v parent_t - (** The difference between `show_uf` and `show_uf_ugly` is that `show_uf` prints the elements - grouped by equivalence classes, while this function just prints them in any order. - - Throws "Unknown value" if v is not present in the data structure. *) - let show_uf_ugly uf = - List.fold_left (fun s (v, (refv, size)) -> - s ^ "\t" ^ (if is_root uf v then "Root: " else "") ^ T.show v ^ - "; Parent: " ^ T.show (fst refv) ^ "; offset: " ^ Z.to_string (snd refv) ^ "; size: " ^ string_of_int size ^ "\n") - "" (ValMap.bindings uf) ^ "\n" - (** For a variable t it returns the reference variable v and the offset r. This find performs path compression. @@ -609,13 +606,6 @@ module UnionFind = struct else search v' (v :: list) in search v' [v]) - (** Returns None if the value v is not present in the datat structure or if the data structure is in an invalid state.*) - let find_opt uf v = match find uf v with - | exception (UnknownValue _) - | exception Not_found - | exception (InvalidUnionFind _) -> None - | res -> Some res - (** For a variable t it returns the reference variable v and the offset r. This find DOES NOT perform path compression. @@ -673,6 +663,7 @@ module UnionFind = struct "; o: " ^ Z.to_string (snd t) ^ "; s: " ^ string_of_int size ^")\n") "" eq_class ^ "----\n") "" (get_eq_classes uf) ^ "\n" + (** Returns a list of representative elements.*) let get_representatives uf = List.filter_map (fun (el,_) -> if is_root uf el then Some el else None) (TMap.bindings uf) end @@ -735,15 +726,4 @@ module LookupMap = struct match find_opt v map with | None -> [] | Some zmap -> zmap_bindings zmap - - (** Filters elements from the mapped values which fulfil the predicate p. *) - let filter_if (map:t) p = - TMap.filter_map (fun _ zmap -> - let zmap = ZMap.filter (fun key value -> p value) zmap - in if ZMap.is_empty zmap then None else Some zmap) map - - (** Maps elements from the mapped values by applying the function f to them. *) - let map_values (map:t) f = - TMap.map (fun zmap -> - ZMap.map f zmap) map end From 498cd404707ea7ed17fc28cddb06d94f58ae354b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 16:54:58 +0200 Subject: [PATCH 301/323] remove useless module --- src/analyses/c2poAnalysis.ml | 1 - src/cdomains/c2poDomain.ml | 1 - src/cdomains/congruenceClosure.ml | 2335 ++++++++++++++--------------- 3 files changed, 1166 insertions(+), 1171 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index 6a09a49b6c..c09549f546 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -4,7 +4,6 @@ open Analyses open GoblintCil open C2poDomain open CongruenceClosure -open C2PO open Batteries open SingleThreadedLifter open DuplicateVars diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index c782c79c2d..dcac36391c 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -3,7 +3,6 @@ open Batteries open GoblintCil open CongruenceClosure -open C2PO module M = Messages open DuplicateVars diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 8c9c2f1bc6..cc47554217 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1,333 +1,333 @@ -(** OCaml implementation of a quantitative congruence closure. *) +(** OCaml implementation of a quantitative congruence closure. + It is used by the C-2PO Analysis and based on the UnionFind implementation. +*) include UnionFind open Batteries open GoblintCil open DuplicateVars module M = Messages -(** Quantitative congruence closure on terms *) -module C2PO = struct - module TUF = UnionFind - module LMap = LookupMap +module TUF = UnionFind +module LMap = LookupMap - (* block disequalities *) - module BlDis = struct - (** Block disequalities: - a term t1 is mapped to a set of terms that have a different block than t1. - It is allowed to contain terms that are not present in the data structure, - so we shouldn't assume that all terms in bldis are present in the union find! - *) - type t = TSet.t TMap.t [@@deriving eq, ord, hash] - - let bindings = TMap.bindings - let empty = TMap.empty - let is_empty = TMap.is_empty - - let to_conj bldiseq = List.fold - (fun list (t1, tset) -> - TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list - ) [] (bindings bldiseq) - - let add bldiseq t1 t2 = - match TMap.find_opt t1 bldiseq with - | None -> TMap.add t1 (TSet.singleton t2) bldiseq - | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq - - (** Add disequalities bl(t1) != bl(t2) and bl(t2) != bl(t1). *) - let add_block_diseq bldiseq (t1, t2) = - add (add bldiseq t1 t2) t2 t1 - - (** - params: - - t1-> a term that is NOT present in the data structure - - tlist: a list of representative terms - - For each term t2 in tlist, it adds the disequality t1 != t2 to diseqs. - *) - let add_block_diseqs bldiseq uf t1 tlist = - List.fold (fun bldiseq t2 -> - add_block_diseq bldiseq (t1, t2)) bldiseq tlist - - (** Find all elements that are in the same equivalence class as t, - given the cmap, but only those that are now representatives in the union find uf. *) - let comp_t_cmap_repr cmap t uf = - match TMap.find_opt t cmap with - | None -> [Z.zero, t] - | Some zmap -> - List.concat_map - (fun (z, set) -> - List.cartesian_product [z] (TSet.to_list (*TSet.filter (TUF.is_root uf*) set)) (ZMap.bindings zmap) - - (** For each block disequality bl(t1) != bl(t2) we add all disequalities - that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', - then we add the disequaity bl(t1') != bl(t2'), - but only for t1' and t2' which are roots in uf. - *) - let element_closure bldis cmap uf = - let comp_closure = function - | BlNequal (r1,r2) -> - let eq_class1, eq_class2 = comp_t_cmap_repr cmap r1 uf, comp_t_cmap_repr cmap r2 uf in - List.cartesian_product (List.map snd eq_class1) (List.map snd eq_class2) - | _ -> [] - in - List.concat_map comp_closure bldis +(* block disequalities *) +module BlDis = struct + (** Block disequalities: + a term t1 is mapped to a set of terms that have a different block than t1. + It is allowed to contain terms that are not present in the data structure, + so we shouldn't assume that all terms in bldis are present in the union find! + *) + type t = TSet.t TMap.t [@@deriving eq, ord, hash] - let map_set_mem v v' (map:t) = match TMap.find_opt v map with - | None -> false - | Some set -> TSet.mem v' set - - let filter_map f (diseq:t) = - TMap.filter_map - (fun _ s -> let set = TSet.filter_map f s in - if TSet.is_empty set then None else Some set) diseq - - let shift v r v' (map:t) = - match TMap.find_opt v' map with - | None -> map - | Some tset -> - TMap.remove v' (TMap.add v tset map) - - let term_set bldis = - TSet.of_enum (TMap.keys bldis) - - let map_lhs = - let add_change bldis (t1,t2) = - match TMap.find_opt t1 bldis with - | None -> bldis - | Some tset -> TMap.add t2 tset (TMap.remove t1 bldis) in - List.fold add_change - - let filter_map_lhs f (diseq:t) = - Enum.fold - (fun diseq t -> match f t with - | None -> TMap.remove t diseq - | Some t2 -> - if not (T.equal t t2) - then TMap.add t2 (TMap.find t diseq) (TMap.remove t diseq) else - diseq) diseq (TMap.keys diseq) - end - - module Disequalities = struct - - (* disequality map: - if t_1 -> z -> {t_2, t_3} - then we know that t_1 + z != t_2 - and also that t_1 + z != t_3 - *) - type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) - type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) - - let empty = TMap.empty - let is_empty = TMap.is_empty - let remove = TMap.remove - (** Returns a list of tuples, which each represent a disequality *) - let bindings = - List.flatten % - List.concat_map - (fun (t, smap) -> - List.map (fun (z, tset) -> - List.map (fun term -> - (t,z,term)) (TSet.elements tset)) - (ZMap.bindings smap) - ) % TMap.bindings - - let bindings_args = - List.flatten % + let bindings = TMap.bindings + let empty = TMap.empty + let is_empty = TMap.is_empty + + let to_conj bldiseq = List.fold + (fun list (t1, tset) -> + TSet.fold (fun t2 bldiseqs -> BlNequal(t1, t2)::bldiseqs) tset [] @ list + ) [] (bindings bldiseq) + + let add bldiseq t1 t2 = + match TMap.find_opt t1 bldiseq with + | None -> TMap.add t1 (TSet.singleton t2) bldiseq + | Some tset -> TMap.add t1 (TSet.add t2 tset) bldiseq + + (** Add disequalities bl(t1) != bl(t2) and bl(t2) != bl(t1). *) + let add_block_diseq bldiseq (t1, t2) = + add (add bldiseq t1 t2) t2 t1 + + (** + params: + + t1-> a term that is NOT present in the data structure + + tlist: a list of representative terms + + For each term t2 in tlist, it adds the disequality t1 != t2 to diseqs. + *) + let add_block_diseqs bldiseq uf t1 tlist = + List.fold (fun bldiseq t2 -> + add_block_diseq bldiseq (t1, t2)) bldiseq tlist + + (** Find all elements that are in the same equivalence class as t, + given the cmap, but only those that are now representatives in the union find uf. *) + let comp_t_cmap_repr cmap t uf = + match TMap.find_opt t cmap with + | None -> [Z.zero, t] + | Some zmap -> List.concat_map - (fun (t, smap) -> - List.map (fun (z, arglist) -> - List.map (fun (a,b) -> - (t,z,a,b)) arglist) - (ZMap.bindings smap) - ) % TMap.bindings - - (** adds a mapping v -> r -> size -> { v' } to the map, - or if there are already elements - in v -> r -> {..} then v' is added to the previous set *) - let map_set_add (v,r) v' (map:t) = match TMap.find_opt v map with - | None -> TMap.add v (ZMap.add r (TSet.singleton v') ZMap.empty) map - | Some imap -> TMap.add v ( - match ZMap.find_opt r imap with - | None -> ZMap.add r (TSet.singleton v') imap - | Some set -> ZMap.add r (TSet.add v' set) imap) map - - let shift = LMap.shift - - let map_set_mem (v,r) v' (map:t) = match TMap.find_opt v map with - | None -> false - | Some imap -> (match ZMap.find_opt r imap with - | None -> false - | Some set -> TSet.mem v' set - ) - - (** Map of partition, transform union find to a map - of type V -> Z -> V set - with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) - let comp_map uf = - List.fold_left (fun (comp,uf) (v,_) -> - let t,z,uf = TUF.find uf v in - map_set_add (t,z) v comp,uf) - (TMap.empty, uf) (TMap.bindings uf) - - (** Find all elements that are in the same equivalence class as t. *) - let comp_t uf t = - let (t',z',uf) = TUF.find uf t in - fst(List.fold_left (fun (comp,uf) (v,((p,z),_)) -> - let v', z'',uf = TUF.find uf v in - if T.equal v' t' then (v, Z.(z'-z''))::comp,uf else comp,uf - ) - ([],uf) (TMap.bindings uf)) - - (** arg: - - maps each representative term t to a map that maps an integer Z to - a list of representatives t' of v where *(v + z') is - in the representative class of t. - - It basically maps each state in the automata to its predecessors. *) - let get_args uf = - let cmap,uf = comp_map uf in - let clist = TMap.bindings cmap in - let arg = List.fold_left (fun arg (v, imap) -> - let ilist = ZMap.bindings imap in - let iarg = List.fold_left (fun iarg (r,set) -> - let uf,list = List.fold_left (fun (uf,list) el -> - match el with - | Deref (v', r', _) -> - let v0,r0,uf = TUF.find uf v' in - uf,(v0,Z.(r0+r'))::list - | _ -> uf,list) (uf,[]) (TSet.elements set) in - ZMap.add r list iarg) ZMap.empty ilist in - TMap.add v iarg arg) TMap.empty clist in - (uf,cmap,arg) - - let fold_left2 f acc l1 l2 = - List.fold_left ( - fun acc x -> List.fold_left ( - fun acc y -> f acc x y) acc l2) acc l1 - - let map2 f l1 l2 = List.concat_map (fun x -> - List.map (fun y -> f x y) l2) l1 - - let map_find_opt (v,r) map = match TMap.find_opt v map with - | None -> None - | Some imap -> (match ZMap.find_opt r imap with - | None -> None - | Some v -> Some v - ) - - let map_find_all t map = - match TMap.find_opt t map with - | None -> [] - | Some imap -> List.fold (fun list (z,list2) -> - list@list2 - ) [] (ZMap.bindings imap) - - (** Find all disequalities of the form t1 != z2-z1 + t2 - that can be inferred from equalities of the form *(z1 + t1) = *(z2 + t2). - *) - let check_neq (_,arg) rest (v,zmap) = - let zlist = ZMap.bindings zmap in - fold_left2 (fun rest (r1,_) (r2,_) -> - if Z.equal r1 r2 then rest - else (* r1 <> r2 *) - let l1 = match map_find_opt (v,r1) arg - with None -> [] - | Some list -> list in - (* just take the elements of set1 ? *) - let l2 = match map_find_opt (v,r2) arg - with None -> [] - | Some list -> list in - fold_left2 (fun rest (v1,r'1) (v2,r'2) -> - if T.equal v1 v2 then if Z.equal r'1 r'2 - then raise Unsat - else rest - else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 - ) rest zlist zlist - - (** Find all disequalities of the form t1 != z2-z1 + t2 - that can be inferred from block equalities of the form bl( *(z1 + t1) ) = bl( *(z2 + t2) ). - *) - let check_neq_bl (uf,arg) rest (t1, tset) = - List.fold (fun rest t2 -> - (* We know that r1 <> r2, otherwise it would be Unsat. *) - let l1 = map_find_all t1 arg in - let l2 = map_find_all t2 arg in + (fun (z, set) -> + List.cartesian_product [z] (TSet.to_list (*TSet.filter (TUF.is_root uf*) set)) (ZMap.bindings zmap) + + (** For each block disequality bl(t1) != bl(t2) we add all disequalities + that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', + then we add the disequaity bl(t1') != bl(t2'), + but only for t1' and t2' which are roots in uf. + *) + let element_closure bldis cmap uf = + let comp_closure = function + | BlNequal (r1,r2) -> + let eq_class1, eq_class2 = comp_t_cmap_repr cmap r1 uf, comp_t_cmap_repr cmap r2 uf in + List.cartesian_product (List.map snd eq_class1) (List.map snd eq_class2) + | _ -> [] + in + List.concat_map comp_closure bldis + + let map_set_mem v v' (map:t) = match TMap.find_opt v map with + | None -> false + | Some set -> TSet.mem v' set + + let filter_map f (diseq:t) = + TMap.filter_map + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) diseq + + let shift v r v' (map:t) = + match TMap.find_opt v' map with + | None -> map + | Some tset -> + TMap.remove v' (TMap.add v tset map) + + let term_set bldis = + TSet.of_enum (TMap.keys bldis) + + let map_lhs = + let add_change bldis (t1,t2) = + match TMap.find_opt t1 bldis with + | None -> bldis + | Some tset -> TMap.add t2 tset (TMap.remove t1 bldis) in + List.fold add_change + + let filter_map_lhs f (diseq:t) = + Enum.fold + (fun diseq t -> match f t with + | None -> TMap.remove t diseq + | Some t2 -> + if not (T.equal t t2) + then TMap.add t2 (TMap.find t diseq) (TMap.remove t diseq) else + diseq) diseq (TMap.keys diseq) +end + +module Disequalities = struct + + (* disequality map: + if t_1 -> z -> {t_2, t_3} + then we know that t_1 + z != t_2 + and also that t_1 + z != t_3 + *) + type t = TSet.t ZMap.t TMap.t [@@deriving eq, ord, hash] (* disequalitites *) + type arg_t = (T.t * Z.t) ZMap.t TMap.t (* maps each state in the automata to its predecessors *) + + let empty = TMap.empty + let is_empty = TMap.is_empty + let remove = TMap.remove + (** Returns a list of tuples, which each represent a disequality *) + let bindings = + List.flatten % + List.concat_map + (fun (t, smap) -> + List.map (fun (z, tset) -> + List.map (fun term -> + (t,z,term)) (TSet.elements tset)) + (ZMap.bindings smap) + ) % TMap.bindings + + let bindings_args = + List.flatten % + List.concat_map + (fun (t, smap) -> + List.map (fun (z, arglist) -> + List.map (fun (a,b) -> + (t,z,a,b)) arglist) + (ZMap.bindings smap) + ) % TMap.bindings + + (** adds a mapping v -> r -> size -> { v' } to the map, + or if there are already elements + in v -> r -> {..} then v' is added to the previous set *) + let map_set_add (v,r) v' (map:t) = match TMap.find_opt v map with + | None -> TMap.add v (ZMap.add r (TSet.singleton v') ZMap.empty) map + | Some imap -> TMap.add v ( + match ZMap.find_opt r imap with + | None -> ZMap.add r (TSet.singleton v') imap + | Some set -> ZMap.add r (TSet.add v' set) imap) map + + let shift = LMap.shift + + let map_set_mem (v,r) v' (map:t) = match TMap.find_opt v map with + | None -> false + | Some imap -> (match ZMap.find_opt r imap with + | None -> false + | Some set -> TSet.mem v' set + ) + + (** Map of partition, transform union find to a map + of type V -> Z -> V set + with reference variable |-> offset |-> all terms that are in the union find with this ref var and offset. *) + let comp_map uf = + List.fold_left (fun (comp,uf) (v,_) -> + let t,z,uf = TUF.find uf v in + map_set_add (t,z) v comp,uf) + (TMap.empty, uf) (TMap.bindings uf) + + (** Find all elements that are in the same equivalence class as t. *) + let comp_t uf t = + let (t',z',uf) = TUF.find uf t in + fst(List.fold_left (fun (comp,uf) (v,((p,z),_)) -> + let v', z'',uf = TUF.find uf v in + if T.equal v' t' then (v, Z.(z'-z''))::comp,uf else comp,uf + ) + ([],uf) (TMap.bindings uf)) + + (** arg: + + maps each representative term t to a map that maps an integer Z to + a list of representatives t' of v where *(v + z') is + in the representative class of t. + + It basically maps each state in the automata to its predecessors. *) + let get_args uf = + let cmap,uf = comp_map uf in + let clist = TMap.bindings cmap in + let arg = List.fold_left (fun arg (v, imap) -> + let ilist = ZMap.bindings imap in + let iarg = List.fold_left (fun iarg (r,set) -> + let uf,list = List.fold_left (fun (uf,list) el -> + match el with + | Deref (v', r', _) -> + let v0,r0,uf = TUF.find uf v' in + uf,(v0,Z.(r0+r'))::list + | _ -> uf,list) (uf,[]) (TSet.elements set) in + ZMap.add r list iarg) ZMap.empty ilist in + TMap.add v iarg arg) TMap.empty clist in + (uf,cmap,arg) + + let fold_left2 f acc l1 l2 = + List.fold_left ( + fun acc x -> List.fold_left ( + fun acc y -> f acc x y) acc l2) acc l1 + + let map2 f l1 l2 = List.concat_map (fun x -> + List.map (fun y -> f x y) l2) l1 + + let map_find_opt (v,r) map = match TMap.find_opt v map with + | None -> None + | Some imap -> (match ZMap.find_opt r imap with + | None -> None + | Some v -> Some v + ) + + let map_find_all t map = + match TMap.find_opt t map with + | None -> [] + | Some imap -> List.fold (fun list (z,list2) -> + list@list2 + ) [] (ZMap.bindings imap) + + (** Find all disequalities of the form t1 != z2-z1 + t2 + that can be inferred from equalities of the form *(z1 + t1) = *(z2 + t2). + *) + let check_neq (_,arg) rest (v,zmap) = + let zlist = ZMap.bindings zmap in + fold_left2 (fun rest (r1,_) (r2,_) -> + if Z.equal r1 r2 then rest + else (* r1 <> r2 *) + let l1 = match map_find_opt (v,r1) arg + with None -> [] + | Some list -> list in + (* just take the elements of set1 ? *) + let l2 = match map_find_opt (v,r2) arg + with None -> [] + | Some list -> list in fold_left2 (fun rest (v1,r'1) (v2,r'2) -> if T.equal v1 v2 then if Z.equal r'1 r'2 then raise Unsat else rest else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 - ) rest (TSet.to_list tset) - - (** Initialize the list of disequalities taking only implicit dis-equalities into account. - - Returns: List of non-trivially implied dis-equalities *) - let init_neq (uf,cmap,arg) = - List.fold_left (check_neq (uf,arg)) [] (TMap.bindings cmap) - - let init_neg_block_diseq (uf, bldis, cmap, arg) = - List.fold_left (check_neq_bl (uf,arg)) [] (TMap.bindings bldis) - - (** Initialize the list of disequalities taking explicit dis-equalities into account. - - Parameters: union-find partition, explicit disequalities.battrs - - Returns: list of normalized provided dis-equalities *) - let init_list_neq uf neg = - List.fold_left (fun (uf, list) (v1,v2,r) -> - let v1,r1,uf = TUF.find uf v1 in - let v2,r2,uf = TUF.find uf v2 in - if T.equal v1 v2 then if Z.(equal r1 (r2+r)) then raise Unsat - else uf,list - else uf,(v1,v2,Z.(r2-r1+r))::list) (uf,[]) neg - - (** Parameter: list of disequalities (t1, t2, z), where t1 and t2 are roots. - - Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. - *) - let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) bldis = function (* v1, v2 are distinct roots with v1 != v2+r *) - | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) - | (v1,v2,r) :: rest -> - (* we don't want to explicitly store disequalities of the kind &x != &y *) - if T.is_addr v1 && T.is_addr v2 || BlDis.map_set_mem v1 v2 bldis then - propagate_neq (uf,cmap,arg,neq) bldis rest else - (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) - if T.equal v1 v2 then - if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) bldis rest - else (* check whether it is already in neq *) - if map_set_mem (v1,Z.(-r)) v2 neq then propagate_neq (uf,cmap,arg,neq) bldis rest - else let neq = map_set_add (v1,Z.(-r)) v2 neq |> - map_set_add (v2,r) v1 in + ) rest zlist zlist + + (** Find all disequalities of the form t1 != z2-z1 + t2 + that can be inferred from block equalities of the form bl( *(z1 + t1) ) = bl( *(z2 + t2) ). + *) + let check_neq_bl (uf,arg) rest (t1, tset) = + List.fold (fun rest t2 -> + (* We know that r1 <> r2, otherwise it would be Unsat. *) + let l1 = map_find_all t1 arg in + let l2 = map_find_all t2 arg in + fold_left2 (fun rest (v1,r'1) (v2,r'2) -> + if T.equal v1 v2 then if Z.equal r'1 r'2 + then raise Unsat + else rest + else (v1,v2,Z.(r'2-r'1))::rest) rest l1 l2 + ) rest (TSet.to_list tset) + + (** Initialize the list of disequalities taking only implicit dis-equalities into account. + + Returns: List of non-trivially implied dis-equalities *) + let init_neq (uf,cmap,arg) = + List.fold_left (check_neq (uf,arg)) [] (TMap.bindings cmap) + + let init_neg_block_diseq (uf, bldis, cmap, arg) = + List.fold_left (check_neq_bl (uf,arg)) [] (TMap.bindings bldis) + + (** Initialize the list of disequalities taking explicit dis-equalities into account. + + Parameters: union-find partition, explicit disequalities.battrs + + Returns: list of normalized provided dis-equalities *) + let init_list_neq uf neg = + List.fold_left (fun (uf, list) (v1,v2,r) -> + let v1,r1,uf = TUF.find uf v1 in + let v2,r2,uf = TUF.find uf v2 in + if T.equal v1 v2 then if Z.(equal r1 (r2+r)) then raise Unsat + else uf,list + else uf,(v1,v2,Z.(r2-r1+r))::list) (uf,[]) neg + + (** Parameter: list of disequalities (t1, t2, z), where t1 and t2 are roots. + + Returns: map `neq` where each representative is mapped to a set of representatives it is not equal to. + *) + let rec propagate_neq (uf,(cmap: TSet.t ZMap.t TMap.t),arg,neq) bldis = function (* v1, v2 are distinct roots with v1 != v2+r *) + | [] -> neq (* uf need not be returned: has been flattened during constr. of cmap *) + | (v1,v2,r) :: rest -> + (* we don't want to explicitly store disequalities of the kind &x != &y *) + if T.is_addr v1 && T.is_addr v2 || BlDis.map_set_mem v1 v2 bldis then + propagate_neq (uf,cmap,arg,neq) bldis rest else + (* v1, v2 are roots; v2 -> r,v1 not yet contained in neq *) + if T.equal v1 v2 then + if Z.equal r Z.zero then raise Unsat else propagate_neq (uf,cmap,arg,neq) bldis rest + else (* check whether it is already in neq *) + if map_set_mem (v1,Z.(-r)) v2 neq then propagate_neq (uf,cmap,arg,neq) bldis rest + else let neq = map_set_add (v1,Z.(-r)) v2 neq |> + map_set_add (v2,r) v1 in (* search components of v1, v2 for elements at distance r to obtain inferred equalities at the same level (not recorded) and then compare their predecessors *) - match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with - | None,_ | _,None -> (*should not happen*) propagate_neq (uf,cmap,arg,neq) bldis rest - | Some imap1, Some imap2 -> - let ilist1 = ZMap.bindings imap1 in - let rest = List.fold_left (fun rest (r1,_) -> - match ZMap.find_opt Z.(r1+r) imap2 with - | None -> rest - | Some _ -> - let l1 = match map_find_opt (v1,r1) arg - with None -> [] - | Some list -> list in - let l2 = match map_find_opt (v2,Z.(r1+r)) arg - with None -> [] - | Some list -> list in - fold_left2 (fun rest (v1',r'1) (v2',r'2) -> - if T.equal v1' v2' then if Z.equal r'1 r'2 then raise Unsat - else rest - else - (v1',v2',Z.(r'2-r'1))::rest ) rest l1 l2) - rest ilist1 in - propagate_neq (uf,cmap,arg,neq) bldis rest + match TMap.find_opt v1 (cmap:t), TMap.find_opt v2 cmap with + | None,_ | _,None -> (*should not happen*) propagate_neq (uf,cmap,arg,neq) bldis rest + | Some imap1, Some imap2 -> + let ilist1 = ZMap.bindings imap1 in + let rest = List.fold_left (fun rest (r1,_) -> + match ZMap.find_opt Z.(r1+r) imap2 with + | None -> rest + | Some _ -> + let l1 = match map_find_opt (v1,r1) arg + with None -> [] + | Some list -> list in + let l2 = match map_find_opt (v2,Z.(r1+r)) arg + with None -> [] + | Some list -> list in + fold_left2 (fun rest (v1',r'1) (v2',r'2) -> + if T.equal v1' v2' then if Z.equal r'1 r'2 then raise Unsat + else rest + else + (v1',v2',Z.(r'2-r'1))::rest ) rest l1 l2) + rest ilist1 in + propagate_neq (uf,cmap,arg,neq) bldis rest (* collection of disequalities: * disequalities originating from different offsets of same root @@ -339,892 +339,890 @@ module C2PO = struct then dis-equate the sets at v1,r1 with v2,r2. *) - let show_neq neq = - let clist = bindings neq in - List.fold_left (fun s (v,r,v') -> - s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " - ^ T.show v' ^ "\n") "" clist - - let show_cmap neq = - let clist = bindings neq in - List.fold_left (fun s (v,r,v') -> - s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " = " - ^ T.show v' ^ "\n") "" clist - - let show_arg arg = - let clist = bindings_args arg in - List.fold_left (fun s (v,z,v',r) -> - s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " --> " - ^ T.show v^ "+"^ Z.to_string z ^ "\n") "" clist - let filter_map f (diseq:t) = - TMap.filter_map - (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ s -> let set = TSet.filter_map f s in - if TSet.is_empty set then None else Some set) - zmap in if ZMap.is_empty zmap then None else Some zmap) diseq - - let get_disequalities = List.map - (fun (t1, z, t2) -> - Nequal (t1,t2,Z.(-z)) - ) % bindings - - (** For each disequality t1 != z + t2 we add all disequalities - that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', - then we add the disequaity t1' != z + z2 - z1 + t2'. - *) - let element_closure diseqs cmap uf = - let comp_closure (r1,r2,z) = - let eq_class1, eq_class2 = BlDis.comp_t_cmap_repr cmap r1 uf, BlDis.comp_t_cmap_repr cmap r2 uf in - List.map (fun ((z1, nt1),(z2, nt2)) -> - (nt1, nt2, Z.(-z2+z+z1))) - (List.cartesian_product eq_class1 eq_class2) - in - List.concat_map comp_closure diseqs - end - - (** Set of subterms which are present in the current data structure. *) - module SSet = struct - type t = TSet.t [@@deriving eq, ord, hash] - - let elements = TSet.elements - let mem = TSet.mem - let add = TSet.add - let fold = TSet.fold - let empty = TSet.empty - let to_list = TSet.to_list - let inter = TSet.inter - let find_opt = TSet.find_opt - let union = TSet.union - - let show_set set = TSet.fold (fun v s -> - s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" - - (** Adds all subterms of t to the SSet and the LookupMap*) - let rec subterms_of_term (set,map) t = match t with - | Addr _ | Aux _ -> (add t set, map) - | Deref (t',z,_) -> - let set = add t set in - let map = LMap.map_add (t',z) t map in - subterms_of_term (set, map) t' - - (** Adds all subterms of the proposition to the SSet and the LookupMap*) - let subterms_of_prop (set,map) = function - | (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 - - let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list - - let fold_atoms f (acc:'a) set:'a = - let exception AtomsDone in - let res = ref acc in - try - TSet.fold (fun (v:T.t) acc -> match v with - | Addr _| Aux _ -> f acc v - | _ -> res := acc; raise AtomsDone) set acc - with AtomsDone -> !res - - let get_atoms set = - (* `elements set` returns a sorted list of the elements. The atoms are always smaller that other terms, - according to our comparison function. Therefore take_while is enough. *) - BatList.take_while (function Addr _ | Aux _ -> true | _ -> false) (elements set) - - (** We try to find the dereferenced term between the already existing terms, in order to remember the information about the exp. *) - let deref_term t z set = - let exp = T.to_cil t in - match find_opt (Deref (t, z, exp)) set with - | None -> Deref (t, z, T.dereference_exp exp z) - | Some t -> t - - (** Sometimes it's important to keep the dereferenced term, - even if it's not technically possible to dereference it from a point of view of the C types. - We still need the dereferenced term for he correctness of some algorithms, - and the resulting expression will never be used, so it doesn't need to be a - C expression hat makes sense. *) - let deref_term_even_if_its_not_possible min_term z set = - match deref_term min_term z set with - | result -> result - | exception (T.UnsupportedCilExpression _) -> - let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr and get_normal_form*) - Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z (Some random_type), random_type)), NoOffset)) - - end - - (** Minimal representatives map. - It maps each representative term of an equivalence class to the minimal term of this representative class. - rep -> (t, z) means that t = rep + z *) - module MRMap = struct - type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] - - let bindings = TMap.bindings - let find = TMap.find - let find_opt = TMap.find_opt - let add = TMap.add - let remove = TMap.remove - let mem = TMap.mem - let empty = TMap.empty - - let show_min_rep min_representatives = - let show_one_rep s (state, (rep, z)) = - s ^ "\tState: " ^ T.show state ^ - "\n\tMin: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")--\n\n" - in - List.fold_left show_one_rep "" (bindings min_representatives) - - let rec update_min_repr (uf, set, map) min_representatives = function - | [] -> min_representatives - | state::queue -> (* process all outgoing edges in order of ascending edge labels *) - match LMap.successors state map with - | edges -> - let process_edge (min_representatives, queue, uf) (edge_z, next_term) = - let next_state, next_z = TUF.find_no_pc uf next_term in - let (min_term, min_z) = find state min_representatives in - let next_min = - (SSet.deref_term_even_if_its_not_possible min_term Z.(edge_z - min_z) set, next_z) in - match TMap.find_opt next_state min_representatives - with - | None -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> - (add next_state next_min min_representatives, queue @ [next_state], uf) - | _ -> (min_representatives, queue, uf) - in - let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges - in update_min_repr (uf, set, map) min_representatives queue - - (** Uses dijkstra algorithm to update the minimal representatives of - the successor nodes of all edges in the queue - and if necessary it recursively updates the minimal representatives of the successor nodes. - The states in the queue must already have an updated min_repr. - This function visits only the successor nodes of the nodes in queue, not the nodes themselves. - Before visiting the nodes, it sorts the queue by the size of the current mininmal representative. - - parameters: - - - `(uf, map)` represent the union find data structure and the corresponding lookup map. - - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. - - `queue` contains the states that need to be processed. - The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. - Therefore the queue is a list of representative terms. - - Returns: - - The map with the minimal representatives - - The union find tree. This might have changed because of path compression. *) - let update_min_repr (uf, set, map) min_representatives queue = - (* order queue by size of the current min representative *) - let queue = - List.sort_unique (fun el1 el2 -> let compare_repr = TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives) in - if compare_repr = 0 then T.compare el1 el2 else compare_repr) (List.filter (TUF.is_root uf) queue) - in update_min_repr (uf, set, map) min_representatives queue - - (** - Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. - - Returns: - - The map with the minimal representatives - - The union find tree. This might have changed because of path compression. *) - let compute_minimal_representatives (uf, set, map) = - if M.tracing then M.trace "c2po-normal-form" "compute_minimal_representatives\n"; - let atoms = SSet.get_atoms set in - (* process all atoms in increasing order *) - let atoms = - List.sort (fun el1 el2 -> - let v1, z1 = TUF.find_no_pc uf el1 in - let v2, z2 = TUF.find_no_pc uf el2 in - let repr_compare = TUF.compare_repr (v1, z1) (v2, z2) - in - if repr_compare = 0 then T.compare el1 el2 else repr_compare) atoms in - let add_atom_to_map (min_representatives, queue, uf) a = - let rep, offs = TUF.find_no_pc uf a in - if not (mem rep min_representatives) then - (add rep (a, offs) min_representatives, queue @ [rep], uf) - else (min_representatives, queue, uf) - in - let (min_representatives, queue, uf) = List.fold_left add_atom_to_map (empty, [], uf) atoms - (* compute the minimal representative of all remaining edges *) - in update_min_repr (uf, set, map) min_representatives queue - - let compute_minimal_representatives a = Timing.wrap "c2po-compute-min-repr" compute_minimal_representatives a - - (** Computes the initial map of minimal representatives. - It maps each element `e` in the set to `(e, 0)`. *) - let initial_minimal_representatives set = - List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) - end - - module Lazy = - struct - include Lazy - let hash x y = 0 - end - - type t = {uf: TUF.t; - set: SSet.t; - map: LMap.t; - normal_form: T.v_prop list Lazy.t[@compare.ignore][@eq.ignore][@hash.ignore]; - diseq: Disequalities.t; - bldis: BlDis.t} - [@@deriving eq, ord, hash] - - let string_of_prop = function - | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 - | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 - | Nequal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 - | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 - | BlNequal (t1,t2) -> "bl(" ^ T.show t1 ^ ") != bl(" ^ T.show t2 ^ ")" - - let show_conj list = List.fold_left - (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list - - (** Returns a list of all the transition that are present in the automata. *) - let get_transitions (uf, map) = - List.concat_map (fun (t, zmap) -> - (List.map (fun (edge_z, res_t) -> - (edge_z, t, TUF.find_no_pc uf res_t)) @@ - (LMap.zmap_bindings zmap))) - (LMap.bindings map) - - let exactly_equal cc1 cc2 = - cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis - - let get_normal_conjunction cc get_normal_repr = - let normalize_equality (t1, t2, z) = - if T.equal t1 t2 && Z.(equal z zero) then None else - Some (Equal (t1, t2, z)) in - let conjunctions_of_atoms = - let atoms = SSet.get_atoms cc.set in - List.filter_map (fun atom -> - let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in - let (min_state, min_z) = get_normal_repr rep_state in - normalize_equality (atom, min_state, Z.(rep_z - min_z)) - ) atoms - in - let conjunctions_of_transitions = - let transitions = get_transitions (cc.uf, cc.map) in - List.filter_map (fun (z,s,(s',z')) -> - let (min_state, min_z) = get_normal_repr s in - let (min_state', min_z') = get_normal_repr s' in - normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) - ) transitions in - (*disequalities*) - let disequalities = Disequalities.get_disequalities cc.diseq in - (* find disequalities between min_repr *) - let normalize_disequality (t1, t2, z) = - let (min_state1, min_z1) = get_normal_repr t1 in - let (min_state2, min_z2) = get_normal_repr t2 in - let new_offset = Z.(-min_z2 + min_z1 + z) in - if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) - else Nequal (min_state2, min_state1, Z.(-new_offset)) - in - if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); - let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in - (* block disequalities *) - let normalize_bldis t = match t with - | BlNequal (t1,t2) -> - let min_state1, _ = get_normal_repr t1 in - let min_state2, _ = get_normal_repr t2 in - if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) - else BlNequal (min_state2, min_state1) - | _ -> t - in - let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in - (* all propositions *) - BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) - - (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) - Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) - (** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) - let get_normal_form cc = - if M.tracing && not (Lazy.is_val cc.normal_form) then M.trace "c2po-normal-form" "Computing normal form"; - Lazy.force cc.normal_form - - (** COnverts normal form to string, but only if it was already computed. *) - let show_normal_form normal_form = - if Lazy.is_val normal_form then show_conj (Lazy.force normal_form) - else "not computed" - - (* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) - Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) - (** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) - let get_conjunction cc = - get_normal_conjunction cc (fun t -> t,Z.zero) - - let reset_normal_form cc = - match cc with - | None -> None - | Some cc -> - Some {cc with normal_form = lazy( - let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in - if M.tracing then M.trace "c2po-min-repr" "COMPUTE MIN REPR: %s" (MRMap.show_min_rep min_repr); - let conj = get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) - in if M.tracing then M.trace "c2po-equal" "COMPUTE NORMAL FORM: %s" (show_conj conj); conj - )} - - let show_all x = "Normal form:\n" ^ - show_conj((get_conjunction x)) ^ - "Union Find partition:\n" ^ - (TUF.show_uf x.uf) - ^ "\nSubterm set:\n" - ^ (SSet.show_set x.set) - ^ "\nLookup map/transitions:\n" - ^ (LMap.show_map x.map) - ^ "\nNeq:\n" - ^ (Disequalities.show_neq x.diseq) - ^ "\nBlock diseqs:\n" - ^ show_conj(BlDis.to_conj x.bldis) - ^ "\nMin repr:\n" - ^ show_normal_form x.normal_form - - (** Splits the conjunction into two groups: the first one contains all equality propositions, - and the second one contains all inequality propositions. *) - let split conj = List.fold_left (fun (pos,neg,bld) -> function - | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg,bld) - | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg,bld) - | BlNequal (t1,t2) -> (pos,neg,(t1,t2)::bld)) ([],[],[]) conj - - (** - returns {uf, set, map, min_repr}, where: - - - `uf` = empty union find structure where the elements are all subterms occuring in the conjunction. - - - `set` = set of all subterms occuring in the conjunction. - - - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t'). - - - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. + let show_neq neq = + let clist = bindings neq in + List.fold_left (fun s (v,r,v') -> + s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " != " + ^ T.show v' ^ "\n") "" clist + + let show_cmap neq = + let clist = bindings neq in + List.fold_left (fun s (v,r,v') -> + s ^ "\t" ^ T.show v ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " = " + ^ T.show v' ^ "\n") "" clist + + let show_arg arg = + let clist = bindings_args arg in + List.fold_left (fun s (v,z,v',r) -> + s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " --> " + ^ T.show v^ "+"^ Z.to_string z ^ "\n") "" clist + let filter_map f (diseq:t) = + TMap.filter_map + (fun _ zmap -> + let zmap = ZMap.filter_map + (fun _ s -> let set = TSet.filter_map f s in + if TSet.is_empty set then None else Some set) + zmap in if ZMap.is_empty zmap then None else Some zmap) diseq + + let get_disequalities = List.map + (fun (t1, z, t2) -> + Nequal (t1,t2,Z.(-z)) + ) % bindings + + (** For each disequality t1 != z + t2 we add all disequalities + that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', + then we add the disequaity t1' != z + z2 - z1 + t2'. *) - let init_cc = - {uf = TUF.empty; set = SSet.empty; map = LMap.empty; normal_form = lazy([]); diseq = Disequalities.empty; bldis = BlDis.empty} + let element_closure diseqs cmap uf = + let comp_closure (r1,r2,z) = + let eq_class1, eq_class2 = BlDis.comp_t_cmap_repr cmap r1 uf, BlDis.comp_t_cmap_repr cmap r2 uf in + List.map (fun ((z1, nt1),(z2, nt2)) -> + (nt1, nt2, Z.(-z2+z+z1))) + (List.cartesian_product eq_class1 eq_class2) + in + List.concat_map comp_closure diseqs +end - (** closure of disequalities *) - let congruence_neq cc neg = +(** Set of subterms which are present in the current data structure. *) +module SSet = struct + type t = TSet.t [@@deriving eq, ord, hash] + + let elements = TSet.elements + let mem = TSet.mem + let add = TSet.add + let fold = TSet.fold + let empty = TSet.empty + let to_list = TSet.to_list + let inter = TSet.inter + let find_opt = TSet.find_opt + let union = TSet.union + + let show_set set = TSet.fold (fun v s -> + s ^ "\t" ^ T.show v ^ ";\n") set "" ^ "\n" + + (** Adds all subterms of t to the SSet and the LookupMap*) + let rec subterms_of_term (set,map) t = match t with + | Addr _ | Aux _ -> (add t set, map) + | Deref (t',z,_) -> + let set = add t set in + let map = LMap.map_add (t',z) t map in + subterms_of_term (set, map) t' + + (** Adds all subterms of the proposition to the SSet and the LookupMap*) + let subterms_of_prop (set,map) = function + | (t1,t2,_) -> subterms_of_term (subterms_of_term (set,map) t1) t2 + + let subterms_of_conj list = List.fold_left subterms_of_prop (TSet.empty, LMap.empty) list + + let fold_atoms f (acc:'a) set:'a = + let exception AtomsDone in + let res = ref acc in try - let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in - (* getting args of dereferences *) - let uf,cmap,arg = Disequalities.get_args cc.uf in - (* taking implicit dis-equalities into account *) - let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap, arg) in - let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) cc.bldis neq_list in - (* taking explicit dis-equalities into account *) - let uf,neq_list = Disequalities.init_list_neq uf neg in - let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) cc.bldis neq_list in - if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); - Some {uf; set=cc.set; map=cc.map; normal_form=cc.normal_form;diseq=neq; bldis=cc.bldis} - with Unsat -> None - - let congruence_neq_opt cc neq = match cc with - | None -> None - | Some cc -> congruence_neq cc neq - - (** - parameters: (uf, map, new_repr) equalities. - - returns updated (uf, map, new_repr), where: + TSet.fold (fun (v:T.t) acc -> match v with + | Addr _| Aux _ -> f acc v + | _ -> res := acc; raise AtomsDone) set acc + with AtomsDone -> !res + + let get_atoms set = + (* `elements set` returns a sorted list of the elements. The atoms are always smaller that other terms, + according to our comparison function. Therefore take_while is enough. *) + BatList.take_while (function Addr _ | Aux _ -> true | _ -> false) (elements set) + + (** We try to find the dereferenced term between the already existing terms, in order to remember the information about the exp. *) + let deref_term t z set = + let exp = T.to_cil t in + match find_opt (Deref (t, z, exp)) set with + | None -> Deref (t, z, T.dereference_exp exp z) + | Some t -> t + + (** Sometimes it's important to keep the dereferenced term, + even if it's not technically possible to dereference it from a point of view of the C types. + We still need the dereferenced term for he correctness of some algorithms, + and the resulting expression will never be used, so it doesn't need to be a + C expression hat makes sense. *) + let deref_term_even_if_its_not_possible min_term z set = + match deref_term min_term z set with + | result -> result + | exception (T.UnsupportedCilExpression _) -> + let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr and get_normal_form*) + Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z (Some random_type), random_type)), NoOffset)) - `uf` is the new union find data structure after having added all equalities. - - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - - `new_repr` maps each term that changed its representative term to the new representative. - It can be given as a parameter to `update_bldis` in order to update the representatives in the block disequalities. - - Throws "Unsat" if a contradiction is found. - *) - let rec closure (uf, map, new_repr) = function - | [] -> (uf, map, new_repr) - | (t1, t2, r)::rest -> - (let v1, r1, uf = TUF.find uf t1 in - let v2, r2, uf = TUF.find uf t2 in - let sizet1, sizet2 = T.get_size t1, T.get_size t2 in - if not (Z.equal sizet1 sizet2) then - (if M.tracing then M.trace "c2po" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); - closure (uf, map, new_repr) rest) else - if T.equal v1 v2 then - (* t1 and t2 are in the same equivalence class *) - if Z.equal r1 Z.(r2 + r) then closure (uf, map, new_repr) rest - else raise Unsat - else let diff_r = Z.(r2 - r1 + r) in - let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) - (* update new_representative *) - let new_repr = if T.equal v v1 then TMap.add v2 v new_repr else TMap.add v1 v new_repr in - (* update map *) - let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with - | None, _, false -> map, rest - | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest - | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest - | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) - | Some imap1, Some imap2, true -> (* v1 is new root *) - (* zmap describes args of Deref *) - let r0 = Z.(r2-r1+r) in (* difference between roots *) - (* we move all entries of imap2 to imap1 *) - let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = match LMap.zmap_find_opt r' zmap with - | None -> rest - | Some v'' -> (v', v'', Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) - (imap1,rest) infl2 in - LMap.remove v2 (LMap.add v zmap map), rest - | Some imap1, Some imap2, false -> (* v2 is new root *) - let r0 = Z.(r1-r2-r) in - let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in - let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> - let rest = - match LMap.zmap_find_opt r' zmap with - | None -> rest - | Some v'' -> (v', v'',Z.zero)::rest - in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in - LMap.remove v1 (LMap.add v zmap map), rest - in - closure (uf, map, new_repr) rest - ) +end - (** Update block disequalities with the new representatives, *) - let update_bldis new_repr bldis = - let bldis = BlDis.map_lhs bldis (TMap.bindings new_repr) in - (* update block disequalities with the new representatives *) - let find_new_root t1 = Option.default t1 (TMap.find_opt t1 new_repr) in - BlDis.filter_map (fun t1 -> Some (find_new_root t1)) bldis +(** Minimal representatives map. + It maps each representative term of an equivalence class to the minimal term of this representative class. + rep -> (t, z) means that t = rep + z *) +module MRMap = struct + type t = (T.t * Z.t) TMap.t [@@deriving eq, ord, hash] + + let bindings = TMap.bindings + let find = TMap.find + let find_opt = TMap.find_opt + let add = TMap.add + let remove = TMap.remove + let mem = TMap.mem + let empty = TMap.empty + + let show_min_rep min_representatives = + let show_one_rep s (state, (rep, z)) = + s ^ "\tState: " ^ T.show state ^ + "\n\tMin: (" ^ T.show rep ^ ", " ^ Z.to_string z ^ ")--\n\n" + in + List.fold_left show_one_rep "" (bindings min_representatives) + + let rec update_min_repr (uf, set, map) min_representatives = function + | [] -> min_representatives + | state::queue -> (* process all outgoing edges in order of ascending edge labels *) + match LMap.successors state map with + | edges -> + let process_edge (min_representatives, queue, uf) (edge_z, next_term) = + let next_state, next_z = TUF.find_no_pc uf next_term in + let (min_term, min_z) = find state min_representatives in + let next_min = + (SSet.deref_term_even_if_its_not_possible min_term Z.(edge_z - min_z) set, next_z) in + match TMap.find_opt next_state min_representatives + with + | None -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | Some current_min when T.compare (fst next_min) (fst current_min) < 0 -> + (add next_state next_min min_representatives, queue @ [next_state], uf) + | _ -> (min_representatives, queue, uf) + in + let (min_representatives, queue, uf) = List.fold_left process_edge (min_representatives, queue, uf) edges + in update_min_repr (uf, set, map) min_representatives queue + + (** Uses dijkstra algorithm to update the minimal representatives of + the successor nodes of all edges in the queue + and if necessary it recursively updates the minimal representatives of the successor nodes. + The states in the queue must already have an updated min_repr. + This function visits only the successor nodes of the nodes in queue, not the nodes themselves. + Before visiting the nodes, it sorts the queue by the size of the current mininmal representative. + + parameters: + + - `(uf, map)` represent the union find data structure and the corresponding lookup map. + - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. + - `queue` contains the states that need to be processed. + The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. + Therefore the queue is a list of representative terms. + + Returns: + - The map with the minimal representatives + - The union find tree. This might have changed because of path compression. *) + let update_min_repr (uf, set, map) min_representatives queue = + (* order queue by size of the current min representative *) + let queue = + List.sort_unique (fun el1 el2 -> let compare_repr = TUF.compare_repr (find el1 min_representatives) (find el2 min_representatives) in + if compare_repr = 0 then T.compare el1 el2 else compare_repr) (List.filter (TUF.is_root uf) queue) + in update_min_repr (uf, set, map) min_representatives queue (** - Parameters: cc conjunctions. - - returns updated cc, where: - - - `uf` is the new union find data structure after having added all equalities. - - - `set` doesn't change + Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. + + Returns: + - The map with the minimal representatives + - The union find tree. This might have changed because of path compression. *) + let compute_minimal_representatives (uf, set, map) = + if M.tracing then M.trace "c2po-normal-form" "compute_minimal_representatives\n"; + let atoms = SSet.get_atoms set in + (* process all atoms in increasing order *) + let atoms = + List.sort (fun el1 el2 -> + let v1, z1 = TUF.find_no_pc uf el1 in + let v2, z2 = TUF.find_no_pc uf el2 in + let repr_compare = TUF.compare_repr (v1, z1) (v2, z2) + in + if repr_compare = 0 then T.compare el1 el2 else repr_compare) atoms in + let add_atom_to_map (min_representatives, queue, uf) a = + let rep, offs = TUF.find_no_pc uf a in + if not (mem rep min_representatives) then + (add rep (a, offs) min_representatives, queue @ [rep], uf) + else (min_representatives, queue, uf) + in + let (min_representatives, queue, uf) = List.fold_left add_atom_to_map (empty, [], uf) atoms + (* compute the minimal representative of all remaining edges *) + in update_min_repr (uf, set, map) min_representatives queue - - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). + let compute_minimal_representatives a = Timing.wrap "c2po-compute-min-repr" compute_minimal_representatives a - - `diseq` are the disequalities between the new representatives. + (** Computes the initial map of minimal representatives. + It maps each element `e` in the set to `(e, 0)`. *) + let initial_minimal_representatives set = + List.fold_left (fun map element -> add element (element, Z.zero) map) empty (SSet.elements set) +end - - `bldis` are the block disequalities between the new representatives. +module Lazy = +struct + include Lazy + let hash x y = 0 +end - Throws "Unsat" if a contradiction is found. - This does NOT update the disequalities. - They need to be updated with `congruence_neq`. - *) - let closure cc conjs = +type t = {uf: TUF.t; + set: SSet.t; + map: LMap.t; + normal_form: T.v_prop list Lazy.t[@compare.ignore][@eq.ignore][@hash.ignore]; + diseq: Disequalities.t; + bldis: BlDis.t} +[@@deriving eq, ord, hash] + +let string_of_prop = function + | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 + | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 + | Nequal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 + | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 + | BlNequal (t1,t2) -> "bl(" ^ T.show t1 ^ ") != bl(" ^ T.show t2 ^ ")" + +let show_conj list = List.fold_left + (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list + +(** Returns a list of all the transition that are present in the automata. *) +let get_transitions (uf, map) = + List.concat_map (fun (t, zmap) -> + (List.map (fun (edge_z, res_t) -> + (edge_z, t, TUF.find_no_pc uf res_t)) @@ + (LMap.zmap_bindings zmap))) + (LMap.bindings map) + +let exactly_equal cc1 cc2 = + cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis + +let get_normal_conjunction cc get_normal_repr = + let normalize_equality (t1, t2, z) = + if T.equal t1 t2 && Z.(equal z zero) then None else + Some (Equal (t1, t2, z)) in + let conjunctions_of_atoms = + let atoms = SSet.get_atoms cc.set in + List.filter_map (fun atom -> + let (rep_state, rep_z) = TUF.find_no_pc cc.uf atom in + let (min_state, min_z) = get_normal_repr rep_state in + normalize_equality (atom, min_state, Z.(rep_z - min_z)) + ) atoms + in + let conjunctions_of_transitions = + let transitions = get_transitions (cc.uf, cc.map) in + List.filter_map (fun (z,s,(s',z')) -> + let (min_state, min_z) = get_normal_repr s in + let (min_state', min_z') = get_normal_repr s' in + normalize_equality (SSet.deref_term_even_if_its_not_possible min_state Z.(z - min_z) cc.set, min_state', Z.(z' - min_z')) + ) transitions in + (*disequalities*) + let disequalities = Disequalities.get_disequalities cc.diseq in + (* find disequalities between min_repr *) + let normalize_disequality (t1, t2, z) = + let (min_state1, min_z1) = get_normal_repr t1 in + let (min_state2, min_z2) = get_normal_repr t2 in + let new_offset = Z.(-min_z2 + min_z1 + z) in + if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) + else Nequal (min_state2, min_state1, Z.(-new_offset)) + in + if M.tracing then M.trace "c2po-diseq" "DISEQUALITIES: %s;\nUnion find: %s\nMap: %s\n" (show_conj disequalities) (TUF.show_uf cc.uf) (LMap.show_map cc.map); + let disequalities = List.map (function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> normalize_disequality (t1, t2, z)|BlNequal (t1,t2) -> BlNequal (t1,t2)) disequalities in + (* block disequalities *) + let normalize_bldis t = match t with + | BlNequal (t1,t2) -> + let min_state1, _ = get_normal_repr t1 in + let min_state2, _ = get_normal_repr t2 in + if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) + else BlNequal (min_state2, min_state1) + | _ -> t + in + let conjunctions_of_bl_diseqs = List.map normalize_bldis @@ BlDis.to_conj cc.bldis in + (* all propositions *) + BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) + +(* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) + Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) +(** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) +let get_normal_form cc = + if M.tracing && not (Lazy.is_val cc.normal_form) then M.trace "c2po-normal-form" "Computing normal form"; + Lazy.force cc.normal_form + +(** COnverts normal form to string, but only if it was already computed. *) +let show_normal_form normal_form = + if Lazy.is_val normal_form then show_conj (Lazy.force normal_form) + else "not computed" + +(* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) + Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) +(** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) +let get_conjunction cc = + get_normal_conjunction cc (fun t -> t,Z.zero) + +let reset_normal_form cc = + match cc with + | None -> None + | Some cc -> + Some {cc with normal_form = lazy( + let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in + if M.tracing then M.trace "c2po-min-repr" "COMPUTE MIN REPR: %s" (MRMap.show_min_rep min_repr); + let conj = get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + in if M.tracing then M.trace "c2po-equal" "COMPUTE NORMAL FORM: %s" (show_conj conj); conj + )} + +let show_all x = "Normal form:\n" ^ + show_conj((get_conjunction x)) ^ + "Union Find partition:\n" ^ + (TUF.show_uf x.uf) + ^ "\nSubterm set:\n" + ^ (SSet.show_set x.set) + ^ "\nLookup map/transitions:\n" + ^ (LMap.show_map x.map) + ^ "\nNeq:\n" + ^ (Disequalities.show_neq x.diseq) + ^ "\nBlock diseqs:\n" + ^ show_conj(BlDis.to_conj x.bldis) + ^ "\nMin repr:\n" + ^ show_normal_form x.normal_form + +(** Splits the conjunction into two groups: the first one contains all equality propositions, + and the second one contains all inequality propositions. *) +let split conj = List.fold_left (fun (pos,neg,bld) -> function + | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg,bld) + | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg,bld) + | BlNequal (t1,t2) -> (pos,neg,(t1,t2)::bld)) ([],[],[]) conj + +(** + returns {uf, set, map, min_repr}, where: + + - `uf` = empty union find structure where the elements are all subterms occuring in the conjunction. + + - `set` = set of all subterms occuring in the conjunction. + + - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t'). + + - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. +*) +let init_cc = + {uf = TUF.empty; set = SSet.empty; map = LMap.empty; normal_form = lazy([]); diseq = Disequalities.empty; bldis = BlDis.empty} + +(** closure of disequalities *) +let congruence_neq cc neg = + try + let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in + (* getting args of dereferences *) + let uf,cmap,arg = Disequalities.get_args cc.uf in + (* taking implicit dis-equalities into account *) + let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap, arg) in + let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) cc.bldis neq_list in + (* taking explicit dis-equalities into account *) + let uf,neq_list = Disequalities.init_list_neq uf neg in + let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) cc.bldis neq_list in + if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); + Some {uf; set=cc.set; map=cc.map; normal_form=cc.normal_form;diseq=neq; bldis=cc.bldis} + with Unsat -> None + +let congruence_neq_opt cc neq = match cc with + | None -> None + | Some cc -> congruence_neq cc neq + +(** + parameters: (uf, map, new_repr) equalities. + + returns updated (uf, map, new_repr), where: + + `uf` is the new union find data structure after having added all equalities. + + `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). + + `new_repr` maps each term that changed its representative term to the new representative. + It can be given as a parameter to `update_bldis` in order to update the representatives in the block disequalities. + + Throws "Unsat" if a contradiction is found. +*) +let rec closure (uf, map, new_repr) = function + | [] -> (uf, map, new_repr) + | (t1, t2, r)::rest -> + (let v1, r1, uf = TUF.find uf t1 in + let v2, r2, uf = TUF.find uf t2 in + let sizet1, sizet2 = T.get_size t1, T.get_size t2 in + if not (Z.equal sizet1 sizet2) then + (if M.tracing then M.trace "c2po" "ignoring equality because the sizes are not the same: %s = %s + %s" (T.show t1) (Z.to_string r) (T.show t2); + closure (uf, map, new_repr) rest) else + if T.equal v1 v2 then + (* t1 and t2 are in the same equivalence class *) + if Z.equal r1 Z.(r2 + r) then closure (uf, map, new_repr) rest + else raise Unsat + else let diff_r = Z.(r2 - r1 + r) in + let v, uf, b = TUF.union uf v1 v2 diff_r in (* union *) + (* update new_representative *) + let new_repr = if T.equal v v1 then TMap.add v2 v new_repr else TMap.add v1 v new_repr in + (* update map *) + let map, rest = match LMap.find_opt v1 map, LMap.find_opt v2 map, b with + | None, _, false -> map, rest + | None, Some _, true -> LMap.shift v1 Z.(r1-r2-r) v2 map, rest + | Some _, None,false -> LMap.shift v2 Z.(r2-r1+r) v1 map, rest + | _,None,true -> map, rest (* either v1 or v2 does not occur inside Deref *) + | Some imap1, Some imap2, true -> (* v1 is new root *) + (* zmap describes args of Deref *) + let r0 = Z.(r2-r1+r) in (* difference between roots *) + (* we move all entries of imap2 to imap1 *) + let infl2 = List.map (fun (r',v') -> Z.(-r0+r'), v') (LMap.zmap_bindings imap2) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + let rest = match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (v', v'', Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) + (imap1,rest) infl2 in + LMap.remove v2 (LMap.add v zmap map), rest + | Some imap1, Some imap2, false -> (* v2 is new root *) + let r0 = Z.(r1-r2-r) in + let infl1 = List.map (fun (r',v') -> Z.(-r0+r'),v') (LMap.zmap_bindings imap1) in + let zmap,rest = List.fold_left (fun (zmap,rest) (r',v') -> + let rest = + match LMap.zmap_find_opt r' zmap with + | None -> rest + | Some v'' -> (v', v'',Z.zero)::rest + in LMap.zmap_add r' v' zmap, rest) (imap2, rest) infl1 in + LMap.remove v1 (LMap.add v zmap map), rest + in + closure (uf, map, new_repr) rest + ) + +(** Update block disequalities with the new representatives, *) +let update_bldis new_repr bldis = + let bldis = BlDis.map_lhs bldis (TMap.bindings new_repr) in + (* update block disequalities with the new representatives *) + let find_new_root t1 = Option.default t1 (TMap.find_opt t1 new_repr) in + BlDis.filter_map (fun t1 -> Some (find_new_root t1)) bldis + +(** + Parameters: cc conjunctions. + + returns updated cc, where: + + - `uf` is the new union find data structure after having added all equalities. + + - `set` doesn't change + + - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). + + - `diseq` are the disequalities between the new representatives. + + - `bldis` are the block disequalities between the new representatives. + + Throws "Unsat" if a contradiction is found. + This does NOT update the disequalities. + They need to be updated with `congruence_neq`. +*) +let closure cc conjs = + match cc with + | None -> None + | Some cc -> + let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in + let bldis = update_bldis new_repr cc.bldis in + Some {uf; set = cc.set; map; normal_form=cc.normal_form; diseq=cc.diseq; bldis=bldis} + +(** Adds the block disequalities to the cc, but first rewrites them such that + they are disequalities between representatives. The cc should already contain + all the terms that are present in those block disequalities. +*) +let rec add_normalized_bl_diseqs cc = function + | [] -> cc + | (t1,t2)::bl_conjs -> match cc with | None -> None | Some cc -> - let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in - let bldis = update_bldis new_repr cc.bldis in - Some {uf; set = cc.set; map; normal_form=cc.normal_form; diseq=cc.diseq; bldis=bldis} - - (** Adds the block disequalities to the cc, but first rewrites them such that - they are disequalities between representatives. The cc should already contain - all the terms that are present in those block disequalities. - *) - let rec add_normalized_bl_diseqs cc = function - | [] -> cc - | (t1,t2)::bl_conjs -> - match cc with - | None -> None - | Some cc -> - let t1',_,uf = TUF.find cc.uf t1 in - let t2',_,uf = TUF.find uf t2 in - if T.equal t1' t2' then None (*unsatisfiable*) - else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in - add_normalized_bl_diseqs (Some {cc with bldis;uf}) bl_conjs - - (** Add a term to the data structure. - - Returns (reference variable, offset), updated congruence closure *) - let rec insert cc t = - if SSet.mem t cc.set then - let v,z,uf = TUF.find cc.uf t in - (v,z), Some {cc with uf} - else - match t with - | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in + let t1',_,uf = TUF.find cc.uf t1 in + let t2',_,uf = TUF.find uf t2 in + if T.equal t1' t2' then None (*unsatisfiable*) + else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in + add_normalized_bl_diseqs (Some {cc with bldis;uf}) bl_conjs + +(** Add a term to the data structure. + + Returns (reference variable, offset), updated congruence closure *) +let rec insert cc t = + if SSet.mem t cc.set then + let v,z,uf = TUF.find cc.uf t in + (v,z), Some {cc with uf} + else + match t with + | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in + let set = SSet.add t cc.set in + (t, Z.zero), Some {cc with uf; set} + | Deref (t', z, exp) -> + match insert cc t' with + | (v, r), None -> (v, r), None + | (v, r), Some cc -> let set = SSet.add t cc.set in - (t, Z.zero), Some {cc with uf; set} - | Deref (t', z, exp) -> - match insert cc t' with - | (v, r), None -> (v, r), None - | (v, r), Some cc -> - let set = SSet.add t cc.set in - match LMap.map_find_opt (v, Z.(r + z)) cc.map with - | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in - let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {cc with uf; set}) [(t, v', Z.zero)] - | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in - let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {cc with uf; set; map} - - (** Add a term to the data structure. - - Returns (reference variable, offset), updated congruence closure *) - let insert cc t = - match cc with - | None -> (t, Z.zero), None - | Some cc -> let (r, z), cc = insert cc t in - (r, z), cc + match LMap.map_find_opt (v, Z.(r + z)) cc.map with + | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in + let uf = LMap.add t ((t, Z.zero),1) uf in + (v2,z2), closure (Some {cc with uf; set}) [(t, v', Z.zero)] + | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in + let uf = LMap.add t ((t, Z.zero),1) cc.uf in + (t, Z.zero), Some {cc with uf; set; map} - (** Add all terms in a specific set to the data structure. +(** Add a term to the data structure. - Returns updated cc. *) - let insert_set cc t_set = - SSet.fold (fun t cc -> snd (insert cc t)) t_set cc - - (** Returns true if t1 and t2 are equivalent. *) - let rec eq_query cc (t1,t2,r) = + Returns (reference variable, offset), updated congruence closure *) +let insert cc t = + match cc with + | None -> (t, Z.zero), None + | Some cc -> let (r, z), cc = insert cc t in + (r, z), cc + +(** Add all terms in a specific set to the data structure. + + Returns updated cc. *) +let insert_set cc t_set = + SSet.fold (fun t cc -> snd (insert cc t)) t_set cc + +(** Returns true if t1 and t2 are equivalent. *) +let rec eq_query cc (t1,t2,r) = + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + if T.equal v1 v2 && Z.equal r1 Z.(r2 + r) then (true, cc) + else + (* If the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, + i.e. if t1' + z1 = t2' + z2. + This is useful when the dereferenced elements are not pointers. *) + if Z.equal r Z.zero then + match t1,t2 with + | Deref (t1', z1, _), Deref (t2', z2, _) -> + eq_query cc (t1', t2', Z.(z2 - z1)) + | _ -> (false, cc) + else (false,cc) + +let block_neq_query cc (t1,t2) = + let (v1,r1),cc = insert cc t1 in + let (v2,r2),cc = insert cc t2 in + match cc with + | None -> true + | Some cc -> BlDis.map_set_mem v1 v2 cc.bldis + +(** Returns true if t1 and t2 are not equivalent. *) +let neq_query cc (t1,t2,r) = + (* we implicitly assume that &x != &y + z *) + if T.is_addr t1 && T.is_addr t2 then true else let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in - if T.equal v1 v2 && Z.equal r1 Z.(r2 + r) then (true, cc) + (* implicit disequalities following from equalities *) + if T.equal v1 v2 then + if Z.(equal r1 (r2 + r)) then false + else true else - (* If the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, - i.e. if t1' + z1 = t2' + z2. - This is useful when the dereferenced elements are not pointers. *) - if Z.equal r Z.zero then - match t1,t2 with - | Deref (t1', z1, _), Deref (t2', z2, _) -> - eq_query cc (t1', t2', Z.(z2 - z1)) - | _ -> (false, cc) - else (false,cc) - - let block_neq_query cc (t1,t2) = - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - match cc with - | None -> true - | Some cc -> BlDis.map_set_mem v1 v2 cc.bldis - - (** Returns true if t1 and t2 are not equivalent. *) - let neq_query cc (t1,t2,r) = - (* we implicitly assume that &x != &y + z *) - if T.is_addr t1 && T.is_addr t2 then true else - let (v1,r1),cc = insert cc t1 in - let (v2,r2),cc = insert cc t2 in - (* implicit disequalities following from equalities *) - if T.equal v1 v2 then - if Z.(equal r1 (r2 + r)) then false - else true - else - match cc with - | None -> true - | Some cc -> (* implicit disequalities following from block disequalities *) - BlDis.map_set_mem v1 v2 cc.bldis || - (*explicit dsequalities*) - Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq - - (** Adds equalities to the data structure. - Throws "Unsat" if a contradiction is found. - Does not update disequalities. *) - let meet_pos_conjs cc pos_conjs = - let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in - closure cc pos_conjs - in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_conjunction res)) "None" res);res - - (** Adds propositions to the data structure. - Returns None if a contradiction is found. *) - let meet_conjs_opt conjs cc = - let pos_conjs, neg_conjs, bl_conjs = split conjs in - let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in - match add_normalized_bl_diseqs (insert_set (meet_pos_conjs cc pos_conjs) terms_to_add) bl_conjs with - | exception Unsat -> None - | Some cc -> congruence_neq cc neg_conjs - | None -> None - - (** Add proposition t1 = t2 + r to the data structure. - Does not update the disequalities. *) - let add_eq cc (t1, t2, r) = - let (v1, r1), cc = insert cc t1 in - let (v2, r2), cc = insert cc t2 in - let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in - cc - - (** adds block disequalities to cc: - fo each representative t in cc it adds the disequality bl(lterm) != bl(t)*) - let add_block_diseqs cc lterm = - match cc with - | None -> cc - | Some cc -> - let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in - Some {cc with bldis} - - (* Remove variables: *) - let remove_terms_from_eq predicate cc = - let insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in - (* start from all initial states that are still valid and find new representatives if necessary *) - (* new_reps maps each representative term to the new representative of the equivalence class *) - (*but new_reps contains an element but not necessarily the representative!!*) - let find_new_repr state old_rep old_z new_reps = - match LMap.find_opt old_rep new_reps with - | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps - | None -> if not @@ predicate old_rep then - old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) - (* the representative need to be removed from the data structure: state is the new repr.*) - state, Z.zero, TMap.add old_rep (state, old_z) new_reps in - let add_atom (uf, new_reps, new_cc, reachable_old_reps) state = - let old_rep, old_z, uf = TUF.find uf state in - let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in - let new_cc = insert_terms new_cc [state; new_rep] in - let new_cc = closure new_cc [(state, new_rep, new_z)] in - (uf, new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) + match cc with + | None -> true + | Some cc -> (* implicit disequalities following from block disequalities *) + BlDis.map_set_mem v1 v2 cc.bldis || + (*explicit dsequalities*) + Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq + +(** Adds equalities to the data structure. + Throws "Unsat" if a contradiction is found. + Does not update disequalities. *) +let meet_pos_conjs cc pos_conjs = + let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in + closure cc pos_conjs + in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_conjunction res)) "None" res);res + +(** Adds propositions to the data structure. + Returns None if a contradiction is found. *) +let meet_conjs_opt conjs cc = + let pos_conjs, neg_conjs, bl_conjs = split conjs in + let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in + match add_normalized_bl_diseqs (insert_set (meet_pos_conjs cc pos_conjs) terms_to_add) bl_conjs with + | exception Unsat -> None + | Some cc -> congruence_neq cc neg_conjs + | None -> None + +(** Add proposition t1 = t2 + r to the data structure. + Does not update the disequalities. *) +let add_eq cc (t1, t2, r) = + let (v1, r1), cc = insert cc t1 in + let (v2, r2), cc = insert cc t2 in + let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in + cc + +(** adds block disequalities to cc: + fo each representative t in cc it adds the disequality bl(lterm) != bl(t)*) +let add_block_diseqs cc lterm = + match cc with + | None -> cc + | Some cc -> + let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in + Some {cc with bldis} + +(* Remove variables: *) +let remove_terms_from_eq predicate cc = + let insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in + (* start from all initial states that are still valid and find new representatives if necessary *) + (* new_reps maps each representative term to the new representative of the equivalence class *) + (*but new_reps contains an element but not necessarily the representative!!*) + let find_new_repr state old_rep old_z new_reps = + match LMap.find_opt old_rep new_reps with + | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps + | None -> if not @@ predicate old_rep then + old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) + (* the representative need to be removed from the data structure: state is the new repr.*) + state, Z.zero, TMap.add old_rep (state, old_z) new_reps in + let add_atom (uf, new_reps, new_cc, reachable_old_reps) state = + let old_rep, old_z, uf = TUF.find uf state in + let new_rep, new_z, new_reps = find_new_repr state old_rep old_z new_reps in + let new_cc = insert_terms new_cc [state; new_rep] in + let new_cc = closure new_cc [(state, new_rep, new_z)] in + (uf, new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) + in + let uf, new_reps, new_cc, reachable_old_reps = + SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (cc.uf, TMap.empty, (Some init_cc),[]) cc.set in + let cmap,uf = Disequalities.comp_map uf in + (* breadth-first search of reachable states *) + let add_transition (old_rep, new_rep, z1) (uf, new_reps, new_cc, reachable_old_reps) (s_z,s_t) = + let old_rep_s, old_z_s, uf = TUF.find uf s_t in + let find_successor_in_set (z, term_set) = + let exception Found in + let res = ref None in + try + TSet.iter (fun t -> + match SSet.deref_term t Z.(s_z-z) cc.set with + | exception (T.UnsupportedCilExpression _) -> () + | successor -> if (not @@ predicate successor) then + (res := Some successor; raise Found) + else + () + ) term_set; !res + with Found -> !res in - let uf, new_reps, new_cc, reachable_old_reps = - SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (cc.uf, TMap.empty, (Some init_cc),[]) cc.set in - let cmap,uf = Disequalities.comp_map uf in - (* breadth-first search of reachable states *) - let add_transition (old_rep, new_rep, z1) (uf, new_reps, new_cc, reachable_old_reps) (s_z,s_t) = - let old_rep_s, old_z_s, uf = TUF.find uf s_t in - let find_successor_in_set (z, term_set) = - let exception Found in - let res = ref None in - try - TSet.iter (fun t -> - match SSet.deref_term t Z.(s_z-z) cc.set with - | exception (T.UnsupportedCilExpression _) -> () - | successor -> if (not @@ predicate successor) then - (res := Some successor; raise Found) - else - () - ) term_set; !res - with Found -> !res - in - (* find successor term -> find any element in equivalence class that can be dereferenced *) - match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with - | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then - let new_cc = insert_terms new_cc [successor_term] in - match LMap.find_opt old_rep_s new_reps with - | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) - uf, new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps - | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. - -> we choose a successor term *(t+z) for any - -> we need add the successor state to the list of states that still need to be visited - *) - uf, TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps - else - (uf, new_reps, new_cc, reachable_old_reps) - | None -> - (* the term cannot be dereferenced, so we won't add this transition. *) + (* find successor term -> find any element in equivalence class that can be dereferenced *) + match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with + | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then + let new_cc = insert_terms new_cc [successor_term] in + match LMap.find_opt old_rep_s new_reps with + | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) + uf, new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps + | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. + -> we choose a successor term *(t+z) for any + -> we need add the successor state to the list of states that still need to be visited + *) + uf, TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps + else (uf, new_reps, new_cc, reachable_old_reps) + | None -> + (* the term cannot be dereferenced, so we won't add this transition. *) + (uf, new_reps, new_cc, reachable_old_reps) + in + (* find all successors that are still reachable *) + let rec add_transitions uf new_reps new_cc = function + | [] -> new_reps, new_cc + | (old_rep, new_rep, z)::rest -> + let successors = LMap.successors old_rep cc.map in + let uf, new_reps, new_cc, reachable_old_reps = + List.fold (add_transition (old_rep, new_rep,z)) (uf, new_reps, new_cc, []) successors in + add_transitions uf new_reps new_cc (rest@reachable_old_reps) + in add_transitions uf new_reps new_cc + (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) + +(** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. + Returns None if there are no elements in the same equivalence class as t before it was deleted.*) +let find_new_root new_reps uf v = + match TMap.find_opt v new_reps with + | None -> uf, None + | Some (new_t, z1) -> + let t_rep, z2, uf = TUF.find uf new_t in + uf, Some (t_rep, Z.(z2-z1)) + +let remove_terms_from_diseq diseq new_reps cc = + let disequalities = Disequalities.get_disequalities diseq + in + let add_disequality (uf,new_diseq) = function + | Nequal(t1,t2,z) -> + begin match find_new_root new_reps uf t1 with + | uf, Some (t1',z1') -> + begin match find_new_root new_reps uf t2 with + | uf, Some (t2', z2') -> uf, (t1', t2', Z.(z2'+z-z1'))::new_diseq + | _ -> uf, new_diseq + end + | _ -> uf, new_diseq + end + | _-> uf, new_diseq + in + let uf,new_diseq = List.fold add_disequality (cc.uf,[]) disequalities + in congruence_neq {cc with uf} new_diseq + +let remove_terms_from_bldis bldis new_reps cc = + let uf_ref = ref cc.uf in + let find_new_root_term t = + let uf, new_root = find_new_root new_reps !uf_ref t in + uf_ref := uf; + Option.map fst new_root in + let bldis = BlDis.filter_map_lhs find_new_root_term bldis in + !uf_ref, BlDis.filter_map find_new_root_term bldis + +(** Remove terms from the data structure. + It removes all terms for which "predicate" is false, + while maintaining all equalities about variables that are not being removed.*) +let remove_terms predicate cc = + let old_cc = cc in + match remove_terms_from_eq predicate cc with + | new_reps, Some cc -> + let uf,bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in + let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with uf;bldis} in + cc + | _,None -> None + +let remove_terms p cc = Timing.wrap "removing terms" (remove_terms p) cc + +(* join version 1: by using the automaton *) + +let show_pmap pmap= + List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> + s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) + +let join_eq cc1 cc2 = + let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in + let mappings = List.map + (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in + let r2, off2 = TUF.find_no_pc cc2.uf a in + (r1,r2,Z.(off2 - off1)), (a,off1)) atoms in + let add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) = + match Map.find_opt new_element pmap with + | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs + | Some (c, c1_off) -> + pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in + let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some init_cc,[]) mappings in + (* add equalities that make sure that all atoms that have the same + representative are equal. *) + let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = + let a', a_off = TUF.find_no_pc cc1.uf a in + match LMap.map_find_opt (y, Z.(diff + offset)) cc2.map with + | None -> pmap,cc,new_pairs + | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in + match SSet.deref_term t Z.(offset - t1_off) cc1.set with + | exception (T.UnsupportedCilExpression _) -> pmap,cc,new_pairs + | new_term -> + let _ , cc = insert cc new_term in + let new_element = a',b',Z.(b_off - a_off) in + add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) + in + let rec add_edges_to_map pmap cc = function + | [] -> cc, pmap + | (x,y,diff)::rest -> + let t,t1_off = Map.find (x,y,diff) pmap in + let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off diff) (pmap, cc, []) (LMap.successors x cc1.map) in + add_edges_to_map pmap cc (rest@new_pairs) + in + add_edges_to_map pmap cc working_set + +(* join version 2: just look at equivalence classes and not the automaton. *) + +let product_no_automata_over_terms cc1 cc2 terms = + let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in + let mappings = List.map + (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in + let r2, off2 = TUF.find_no_pc cc2.uf a in + (r1,r2,Z.(off2 - off1)), (a,off1)) (SSet.to_list terms) in + let add_term (cc, pmap) (new_element, (new_term, a_off)) = + match Map.find_opt new_element pmap with + | None -> cc, Map.add new_element (new_term, a_off) pmap + | Some (c, c1_off) -> + add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in + List.fold_left add_term (Some init_cc, Map.empty) mappings + +(** Here we do the join without using the automata, because apparently + we don't want to describe the automaton in the paper... + + We construct a new cc that contains the elements of cc1.set U cc2.set + and two elements are in the same equivalence class iff they are in the same eq. class + both in cc1 and in cc2. *) +let join_eq_no_automata cc1 cc2 = + let terms = SSet.union cc1.set cc2.set in + product_no_automata_over_terms cc1 cc2 terms + +(** Same as join, but we only take the terms from the left argument. *) +let widen_eq_no_automata cc1 cc2 = + product_no_automata_over_terms cc1 cc2 cc1.set + +(** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. + + This is done by checking for each disequality if it is implied by both cc. *) +let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = + let _,diseq1,_ = split (Disequalities.get_disequalities diseq1) in + let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in + (* keep all disequalities from diseq1 that are implied by cc2 and + those from diseq2 that are implied by cc1 *) + let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1 cc.uf) in + let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2 cc.uf) in + let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in + let res = congruence_neq cc (diseq1 @ diseq2) + in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res + +(** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. + + This is done by checing for each block disequality if it is implied by both cc. *) +let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = + let bldiseq1 = BlDis.to_conj bldiseq1 in + let bldiseq2 = BlDis.to_conj bldiseq2 in + (* keep all disequalities from diseq1 that are implied by cc2 and + those from diseq2 that are implied by cc1 *) + let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1 cc.uf) in + let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2 cc.uf) in + let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in + let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in + let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms + in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); + {cc with bldis} + +(* Check for equality of two congruence closures, + by comparing the equivalence classes instead of computing the minimal_representative. *) + +(** Compares the equivalence classes of cc1 and those of cc2. *) +let equal_eq_classes cc1 cc2 = + let comp1, comp2 = fst(Disequalities.comp_map cc1.uf), fst(Disequalities.comp_map cc2.uf) in + (* they should have the same number of equivalence classes *) + if TMap.cardinal comp1 <> TMap.cardinal comp2 then false else + (* compare each equivalence class of cc1 with the corresponding eq. class of cc2 *) + let compare_zmap_entry offset zmap2 (z, tset1) = + match ZMap.find_opt Z.(z+offset) zmap2 with + | None -> false + | Some tset2 -> SSet.equal tset1 tset2 in - (* find all successors that are still reachable *) - let rec add_transitions uf new_reps new_cc = function - | [] -> new_reps, new_cc - | (old_rep, new_rep, z)::rest -> - let successors = LMap.successors old_rep cc.map in - let uf, new_reps, new_cc, reachable_old_reps = - List.fold (add_transition (old_rep, new_rep,z)) (uf, new_reps, new_cc, []) successors in - add_transitions uf new_reps new_cc (rest@reachable_old_reps) - in add_transitions uf new_reps new_cc - (List.unique_cmp ~cmp:(Tuple3.compare ~cmp1:(T.compare) ~cmp2:(T.compare) ~cmp3:(Z.compare)) reachable_old_reps) - - (** Find the representative term of the equivalence classes of an element that has already been deleted from the data structure. - Returns None if there are no elements in the same equivalence class as t before it was deleted.*) - let find_new_root new_reps uf v = - match TMap.find_opt v new_reps with - | None -> uf, None - | Some (new_t, z1) -> - let t_rep, z2, uf = TUF.find uf new_t in - uf, Some (t_rep, Z.(z2-z1)) - - let remove_terms_from_diseq diseq new_reps cc = - let disequalities = Disequalities.get_disequalities diseq - in - let add_disequality (uf,new_diseq) = function - | Nequal(t1,t2,z) -> - begin match find_new_root new_reps uf t1 with - | uf, Some (t1',z1') -> - begin match find_new_root new_reps uf t2 with - | uf, Some (t2', z2') -> uf, (t1', t2', Z.(z2'+z-z1'))::new_diseq - | _ -> uf, new_diseq - end - | _ -> uf, new_diseq - end - | _-> uf, new_diseq - in - let uf,new_diseq = List.fold add_disequality (cc.uf,[]) disequalities - in congruence_neq {cc with uf} new_diseq - - let remove_terms_from_bldis bldis new_reps cc = - let uf_ref = ref cc.uf in - let find_new_root_term t = - let uf, new_root = find_new_root new_reps !uf_ref t in - uf_ref := uf; - Option.map fst new_root in - let bldis = BlDis.filter_map_lhs find_new_root_term bldis in - !uf_ref, BlDis.filter_map find_new_root_term bldis - - (** Remove terms from the data structure. - It removes all terms for which "predicate" is false, - while maintaining all equalities about variables that are not being removed.*) - let remove_terms predicate cc = - let old_cc = cc in - match remove_terms_from_eq predicate cc with - | new_reps, Some cc -> - let uf,bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with uf;bldis} in - cc - | _,None -> None - - let remove_terms p cc = Timing.wrap "removing terms" (remove_terms p) cc - - (* join version 1: by using the automaton *) - - let show_pmap pmap= - List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> - s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) - - let join_eq cc1 cc2 = - let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in - let mappings = List.map - (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in - let r2, off2 = TUF.find_no_pc cc2.uf a in - (r1,r2,Z.(off2 - off1)), (a,off1)) atoms in - let add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) = - match Map.find_opt new_element pmap with - | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs - | Some (c, c1_off) -> - pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in - let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some init_cc,[]) mappings in - (* add equalities that make sure that all atoms that have the same - representative are equal. *) - let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = - let a', a_off = TUF.find_no_pc cc1.uf a in - match LMap.map_find_opt (y, Z.(diff + offset)) cc2.map with - | None -> pmap,cc,new_pairs - | Some b -> let b', b_off = TUF.find_no_pc cc2.uf b in - match SSet.deref_term t Z.(offset - t1_off) cc1.set with - | exception (T.UnsupportedCilExpression _) -> pmap,cc,new_pairs - | new_term -> - let _ , cc = insert cc new_term in - let new_element = a',b',Z.(b_off - a_off) in - add_term (pmap, cc, new_pairs) (new_element, (new_term, a_off)) - in - let rec add_edges_to_map pmap cc = function - | [] -> cc, pmap - | (x,y,diff)::rest -> - let t,t1_off = Map.find (x,y,diff) pmap in - let pmap,cc,new_pairs = List.fold_left (add_one_edge y t t1_off diff) (pmap, cc, []) (LMap.successors x cc1.map) in - add_edges_to_map pmap cc (rest@new_pairs) + let compare_with_cc2_eq_class (rep1, zmap1) = + let rep2, offset = TUF.find_no_pc cc2.uf rep1 in + let zmap2 = TMap.find rep2 comp2 in + if ZMap.cardinal zmap2 <> ZMap.cardinal zmap1 then false else + List.for_all (compare_zmap_entry offset zmap2) (ZMap.bindings zmap1) in - add_edges_to_map pmap cc working_set - - (* join version 2: just look at equivalence classes and not the automaton. *) - - let product_no_automata_over_terms cc1 cc2 terms = - let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in - let mappings = List.map - (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in - let r2, off2 = TUF.find_no_pc cc2.uf a in - (r1,r2,Z.(off2 - off1)), (a,off1)) (SSet.to_list terms) in - let add_term (cc, pmap) (new_element, (new_term, a_off)) = - match Map.find_opt new_element pmap with - | None -> cc, Map.add new_element (new_term, a_off) pmap - | Some (c, c1_off) -> - add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in - List.fold_left add_term (Some init_cc, Map.empty) mappings - - (** Here we do the join without using the automata, because apparently - we don't want to describe the automaton in the paper... - - We construct a new cc that contains the elements of cc1.set U cc2.set - and two elements are in the same equivalence class iff they are in the same eq. class - both in cc1 and in cc2. *) - let join_eq_no_automata cc1 cc2 = - let terms = SSet.union cc1.set cc2.set in - product_no_automata_over_terms cc1 cc2 terms - - (** Same as join, but we only take the terms from the left argument. *) - let widen_eq_no_automata cc1 cc2 = - product_no_automata_over_terms cc1 cc2 cc1.set - - (** Joins the disequalities diseq1 and diseq2, given a congruence closure data structure. - - This is done by checking for each disequality if it is implied by both cc. *) - let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = - let _,diseq1,_ = split (Disequalities.get_disequalities diseq1) in - let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in - (* keep all disequalities from diseq1 that are implied by cc2 and - those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1 cc.uf) in - let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2 cc.uf) in - let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in - let res = congruence_neq cc (diseq1 @ diseq2) - in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res - - (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. - - This is done by checing for each block disequality if it is implied by both cc. *) - let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = - let bldiseq1 = BlDis.to_conj bldiseq1 in - let bldiseq2 = BlDis.to_conj bldiseq2 in - (* keep all disequalities from diseq1 that are implied by cc2 and - those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1 cc.uf) in - let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2 cc.uf) in - let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in - let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in - let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms - in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); - {cc with bldis} - - (* Check for equality of two congruence closures, - by comparing the equivalence classes instead of computing the minimal_representative. *) - - (** Compares the equivalence classes of cc1 and those of cc2. *) - let equal_eq_classes cc1 cc2 = - let comp1, comp2 = fst(Disequalities.comp_map cc1.uf), fst(Disequalities.comp_map cc2.uf) in - (* they should have the same number of equivalence classes *) - if TMap.cardinal comp1 <> TMap.cardinal comp2 then false else - (* compare each equivalence class of cc1 with the corresponding eq. class of cc2 *) - let compare_zmap_entry offset zmap2 (z, tset1) = - match ZMap.find_opt Z.(z+offset) zmap2 with - | None -> false - | Some tset2 -> SSet.equal tset1 tset2 - in - let compare_with_cc2_eq_class (rep1, zmap1) = - let rep2, offset = TUF.find_no_pc cc2.uf rep1 in - let zmap2 = TMap.find rep2 comp2 in - if ZMap.cardinal zmap2 <> ZMap.cardinal zmap1 then false else - List.for_all (compare_zmap_entry offset zmap2) (ZMap.bindings zmap1) - in - List.for_all compare_with_cc2_eq_class (TMap.bindings comp1) - - let equal_diseqs cc1 cc2 = - let normalize_diseqs (min_state1, min_state2, new_offset) = - if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) - else Nequal (min_state2, min_state1, Z.(-new_offset)) in - let rename_diseqs dis = match dis with - | Nequal (t1,t2,z) -> - let (min_state1, min_z1) = TUF.find_no_pc cc2.uf t1 in - let (min_state2, min_z2) = TUF.find_no_pc cc2.uf t2 in - let new_offset = Z.(min_z2 - min_z1 + z) in - normalize_diseqs (min_state1, min_state2, new_offset) - | _ -> dis in - let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.map rename_diseqs (Disequalities.get_disequalities cc1.diseq) in - let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.filter_map (function | Nequal (t1,t2,z) -> Some (normalize_diseqs(t1,t2,z)) - | _ -> None) (Disequalities.get_disequalities cc2.diseq) in - List.equal T.equal_v_prop renamed_diseqs normalized_diseqs - - let equal_bldis cc1 cc2 = - let normalize_bldis (min_state1, min_state2) = - if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) - else BlNequal (min_state2, min_state1) in - let rename_bldis dis = match dis with - | BlNequal (t1,t2) -> - let min_state1, _ = TUF.find_no_pc cc2.uf t1 in - let min_state2, _ = TUF.find_no_pc cc2.uf t2 in - normalize_bldis (min_state1, min_state2) - | _ -> dis in - let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.map rename_bldis (BlDis.to_conj cc1.bldis) in - let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ - List.map (function | Nequal (t1,t2,_) | Equal(t1,t2,_) | BlNequal (t1,t2) - -> (normalize_bldis(t1,t2))) (BlDis.to_conj cc2.bldis) in - List.equal T.equal_v_prop renamed_diseqs normalized_diseqs -end + List.for_all compare_with_cc2_eq_class (TMap.bindings comp1) + +let equal_diseqs cc1 cc2 = + let normalize_diseqs (min_state1, min_state2, new_offset) = + if T.compare min_state1 min_state2 < 0 then Nequal (min_state1, min_state2, new_offset) + else Nequal (min_state2, min_state1, Z.(-new_offset)) in + let rename_diseqs dis = match dis with + | Nequal (t1,t2,z) -> + let (min_state1, min_z1) = TUF.find_no_pc cc2.uf t1 in + let (min_state2, min_z2) = TUF.find_no_pc cc2.uf t2 in + let new_offset = Z.(min_z2 - min_z1 + z) in + normalize_diseqs (min_state1, min_state2, new_offset) + | _ -> dis in + let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map rename_diseqs (Disequalities.get_disequalities cc1.diseq) in + let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.filter_map (function | Nequal (t1,t2,z) -> Some (normalize_diseqs(t1,t2,z)) + | _ -> None) (Disequalities.get_disequalities cc2.diseq) in + List.equal T.equal_v_prop renamed_diseqs normalized_diseqs + +let equal_bldis cc1 cc2 = + let normalize_bldis (min_state1, min_state2) = + if T.compare min_state1 min_state2 < 0 then BlNequal (min_state1, min_state2) + else BlNequal (min_state2, min_state1) in + let rename_bldis dis = match dis with + | BlNequal (t1,t2) -> + let min_state1, _ = TUF.find_no_pc cc2.uf t1 in + let min_state2, _ = TUF.find_no_pc cc2.uf t2 in + normalize_bldis (min_state1, min_state2) + | _ -> dis in + let renamed_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map rename_bldis (BlDis.to_conj cc1.bldis) in + let normalized_diseqs = BatList.sort_unique (T.compare_v_prop) @@ + List.map (function | Nequal (t1,t2,_) | Equal(t1,t2,_) | BlNequal (t1,t2) + -> (normalize_bldis(t1,t2))) (BlDis.to_conj cc2.bldis) in + List.equal T.equal_v_prop renamed_diseqs normalized_diseqs (**Find out if two addresses are not equal by using the MayPointTo query*) module MayBeEqual = struct - open C2PO module AD = Queries.AD open Var @@ -1321,5 +1319,4 @@ module MayBeEqual = struct || (may_point_to_one_of_these_adresses ask adresses cc v) | Addr _ -> false | Aux (v,e) -> may_point_to_address ask adresses (Addr v) Z.zero cc - end From c16366ca56e279abeb6f4fa118ae0885b91a1ded Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 7 Aug 2024 17:35:38 +0200 Subject: [PATCH 302/323] add some comments and adapt the structure of the code --- src/cdomains/congruenceClosure.ml | 136 ++++++++++++------------------ src/cdomains/unionFind.ml | 16 +++- 2 files changed, 68 insertions(+), 84 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index cc47554217..1b5441cf58 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -52,30 +52,20 @@ module BlDis = struct List.fold (fun bldiseq t2 -> add_block_diseq bldiseq (t1, t2)) bldiseq tlist - (** Find all elements that are in the same equivalence class as t, - given the cmap, but only those that are now representatives in the union find uf. *) - let comp_t_cmap_repr cmap t uf = - match TMap.find_opt t cmap with - | None -> [Z.zero, t] - | Some zmap -> - List.concat_map - (fun (z, set) -> - List.cartesian_product [z] (TSet.to_list (*TSet.filter (TUF.is_root uf*) set)) (ZMap.bindings zmap) - (** For each block disequality bl(t1) != bl(t2) we add all disequalities that follow from equalities. I.e., if t1 = z1 + t1' and t2 = z2 + t2', - then we add the disequaity bl(t1') != bl(t2'), - but only for t1' and t2' which are roots in uf. + then we add the disequaity bl(t1') != bl(t2'). *) - let element_closure bldis cmap uf = + let element_closure bldis cmap = let comp_closure = function | BlNequal (r1,r2) -> - let eq_class1, eq_class2 = comp_t_cmap_repr cmap r1 uf, comp_t_cmap_repr cmap r2 uf in + let eq_class1, eq_class2 = LMap.comp_t_cmap_repr cmap r1, LMap.comp_t_cmap_repr cmap r2 in List.cartesian_product (List.map snd eq_class1) (List.map snd eq_class2) | _ -> [] in List.concat_map comp_closure bldis + (** Returns true if bl(v) != bl(v'). *) let map_set_mem v v' (map:t) = match TMap.find_opt v map with | None -> false | Some set -> TSet.mem v' set @@ -85,12 +75,6 @@ module BlDis = struct (fun _ s -> let set = TSet.filter_map f s in if TSet.is_empty set then None else Some set) diseq - let shift v r v' (map:t) = - match TMap.find_opt v' map with - | None -> map - | Some tset -> - TMap.remove v' (TMap.add v tset map) - let term_set bldis = TSet.of_enum (TMap.keys bldis) @@ -155,8 +139,6 @@ module Disequalities = struct | None -> ZMap.add r (TSet.singleton v') imap | Some set -> ZMap.add r (TSet.add v' set) imap) map - let shift = LMap.shift - let map_set_mem (v,r) v' (map:t) = match TMap.find_opt v map with | None -> false | Some imap -> (match ZMap.find_opt r imap with @@ -266,16 +248,19 @@ module Disequalities = struct (** Initialize the list of disequalities taking only implicit dis-equalities into account. - Returns: List of non-trivially implied dis-equalities *) + Returns: List of dis-equalities implied by the equalities. *) let init_neq (uf,cmap,arg) = List.fold_left (check_neq (uf,arg)) [] (TMap.bindings cmap) + (** Initialize the list of disequalities taking only implicit dis-equalities into account. + + Returns: List of dis-equalities implied by the block disequalities. *) let init_neg_block_diseq (uf, bldis, cmap, arg) = List.fold_left (check_neq_bl (uf,arg)) [] (TMap.bindings bldis) (** Initialize the list of disequalities taking explicit dis-equalities into account. - Parameters: union-find partition, explicit disequalities.battrs + Parameters: union-find partition, explicit disequalities. Returns: list of normalized provided dis-equalities *) let init_list_neq uf neg = @@ -356,13 +341,7 @@ module Disequalities = struct List.fold_left (fun s (v,z,v',r) -> s ^ "\t" ^ T.show v' ^ ( if Z.equal r Z.zero then "" else if Z.leq r Z.zero then (Z.to_string r) else (" + " ^ Z.to_string r) )^ " --> " ^ T.show v^ "+"^ Z.to_string z ^ "\n") "" clist - let filter_map f (diseq:t) = - TMap.filter_map - (fun _ zmap -> - let zmap = ZMap.filter_map - (fun _ s -> let set = TSet.filter_map f s in - if TSet.is_empty set then None else Some set) - zmap in if ZMap.is_empty zmap then None else Some zmap) diseq + let get_disequalities = List.map (fun (t1, z, t2) -> @@ -375,7 +354,7 @@ module Disequalities = struct *) let element_closure diseqs cmap uf = let comp_closure (r1,r2,z) = - let eq_class1, eq_class2 = BlDis.comp_t_cmap_repr cmap r1 uf, BlDis.comp_t_cmap_repr cmap r2 uf in + let eq_class1, eq_class2 = LMap.comp_t_cmap_repr cmap r1, LMap.comp_t_cmap_repr cmap r2 in List.map (fun ((z1, nt1),(z2, nt2)) -> (nt1, nt2, Z.(-z2+z+z1))) (List.cartesian_product eq_class1 eq_class2) @@ -437,9 +416,9 @@ module SSet = struct (** Sometimes it's important to keep the dereferenced term, even if it's not technically possible to dereference it from a point of view of the C types. - We still need the dereferenced term for he correctness of some algorithms, + We still need the dereferenced term for the correctness of some algorithms, and the resulting expression will never be used, so it doesn't need to be a - C expression hat makes sense. *) + C expression that makes sense. *) let deref_term_even_if_its_not_possible min_term z set = match deref_term min_term z set with | result -> result @@ -500,15 +479,14 @@ module MRMap = struct parameters: - - `(uf, map)` represent the union find data structure and the corresponding lookup map. + - `(uf, set, map)` represent the union find data structure and the corresponding term set and lookup map. - `min_representatives` maps each representative of the union find data structure to the minimal representative of the equivalence class. - `queue` contains the states that need to be processed. The states of the automata are the equivalence classes and each state of the automata is represented by the representative term. Therefore the queue is a list of representative terms. Returns: - - The map with the minimal representatives - - The union find tree. This might have changed because of path compression. *) + - The updated `min_representatives` map with the minimal representatives*) let update_min_repr (uf, set, map) min_representatives queue = (* order queue by size of the current min representative *) let queue = @@ -520,8 +498,8 @@ module MRMap = struct Computes a map that maps each representative of an equivalence class to the minimal representative of the equivalence class. Returns: - - The map with the minimal representatives - - The union find tree. This might have changed because of path compression. *) + - The map with the minimal representatives. + *) let compute_minimal_representatives (uf, set, map) = if M.tracing then M.trace "c2po-normal-form" "compute_minimal_representatives\n"; let atoms = SSet.get_atoms set in @@ -586,6 +564,8 @@ let get_transitions (uf, map) = let exactly_equal cc1 cc2 = cc1.uf == cc2.uf && cc1.map == cc2.map && cc1.diseq == cc2.diseq && cc1.bldis == cc2.bldis +(** Converts the domain representation to a conjunction, using + the function `get_normal_repr` to compute the representatives that need to be used in the conjunction.*) let get_normal_conjunction cc get_normal_repr = let normalize_equality (t1, t2, z) = if T.equal t1 t2 && Z.(equal z zero) then None else @@ -630,24 +610,24 @@ let get_normal_conjunction cc get_normal_repr = (* all propositions *) BatList.sort_unique (T.compare_v_prop) (conjunctions_of_atoms @ conjunctions_of_transitions @ disequalities @ conjunctions_of_bl_diseqs) -(* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) - Basically runtime = O(size of result) if we hadn't removed the trivial conjunctions. *) -(** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) +(** Returns the canonical normal form of the data structure in form of a sorted list of conjunctions. *) let get_normal_form cc = if M.tracing && not (Lazy.is_val cc.normal_form) then M.trace "c2po-normal-form" "Computing normal form"; Lazy.force cc.normal_form -(** COnverts normal form to string, but only if it was already computed. *) +(** Converts the normal form to string, but only if it was already computed. *) let show_normal_form normal_form = if Lazy.is_val normal_form then show_conj (Lazy.force normal_form) else "not computed" -(* Runtime = O(nr. of atoms) + O(nr. transitions in the automata) - Basically runtime = O(size of result if we hadn't removed the trivial conjunctions). *) -(** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. *) +(** Returns a list of conjunctions that follow from the data structure in form of a sorted list of conjunctions. + This is not a normal form, but it is useful to print information + about the current state of the analysis. *) let get_conjunction cc = get_normal_conjunction cc (fun t -> t,Z.zero) +(** Sets the normal_form to an uncomputed value, + that will be lazily computed when it is needed. *) let reset_normal_form cc = match cc with | None -> None @@ -674,28 +654,22 @@ let show_all x = "Normal form:\n" ^ ^ "\nMin repr:\n" ^ show_normal_form x.normal_form -(** Splits the conjunction into two groups: the first one contains all equality propositions, - and the second one contains all inequality propositions. *) +(** Splits the conjunction into three groups: the first one contains all equality propositions, + the second one contains all inequality propositions + and the third one contains all block disequality propositions. *) let split conj = List.fold_left (fun (pos,neg,bld) -> function | Equal (t1,t2,r) -> ((t1,t2,r)::pos,neg,bld) | Nequal(t1,t2,r) -> (pos,(t1,t2,r)::neg,bld) | BlNequal (t1,t2) -> (pos,neg,(t1,t2)::bld)) ([],[],[]) conj (** - returns {uf, set, map, min_repr}, where: - - - `uf` = empty union find structure where the elements are all subterms occuring in the conjunction. - - - `set` = set of all subterms occuring in the conjunction. - - - `map` = for each subterm *(z + t') the map maps t' to a map that maps z to *(z + t'). - - - `min_repr` = maps each representative of an equivalence class to the minimal representative of the equivalence class. + Returns \{uf, set, map, normal_form, bldis, diseq\}, + where all data structures are initialized with an empty map/set. *) let init_cc = {uf = TUF.empty; set = SSet.empty; map = LMap.empty; normal_form = lazy([]); diseq = Disequalities.empty; bldis = BlDis.empty} -(** closure of disequalities *) +(** Computes the closure of disequalities. *) let congruence_neq cc neg = try let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in @@ -778,7 +752,7 @@ let rec closure (uf, map, new_repr) = function closure (uf, map, new_repr) rest ) -(** Update block disequalities with the new representatives, *) +(** Update block disequalities with the new representatives. *) let update_bldis new_repr bldis = let bldis = BlDis.map_lhs bldis (TMap.bindings new_repr) in (* update block disequalities with the new representatives *) @@ -796,7 +770,7 @@ let update_bldis new_repr bldis = - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). - - `diseq` are the disequalities between the new representatives. + - `diseq` doesn't change (it must be updated later to the new representatives). - `bldis` are the block disequalities between the new representatives. @@ -876,7 +850,8 @@ let rec eq_query cc (t1,t2,r) = else (* If the equality is *(t1' + z1) = *(t2' + z2), then we check if the two pointers are equal, i.e. if t1' + z1 = t2' + z2. - This is useful when the dereferenced elements are not pointers. *) + This is useful when the dereferenced elements are not pointers and therefore not stored in our data strutcure. + But we still know that they are equal if the pointers are equal. *) if Z.equal r Z.zero then match t1,t2 with | Deref (t1', z1, _), Deref (t2', z2, _) -> @@ -935,8 +910,8 @@ let add_eq cc (t1, t2, r) = let cc = closure cc [v1, v2, Z.(r2 - r1 + r)] in cc -(** adds block disequalities to cc: - fo each representative t in cc it adds the disequality bl(lterm) != bl(t)*) +(** Adds block disequalities to cc: + for each representative t in cc it adds the disequality bl(lterm) != bl(t)*) let add_block_diseqs cc lterm = match cc with | None -> cc @@ -945,17 +920,18 @@ let add_block_diseqs cc lterm = Some {cc with bldis} (* Remove variables: *) + let remove_terms_from_eq predicate cc = let insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in (* start from all initial states that are still valid and find new representatives if necessary *) (* new_reps maps each representative term to the new representative of the equivalence class *) - (*but new_reps contains an element but not necessarily the representative!!*) + (* but new_reps contains an element but not necessarily the representative *) let find_new_repr state old_rep old_z new_reps = match LMap.find_opt old_rep new_reps with | Some (new_rep,z) -> new_rep, Z.(old_z - z), new_reps | None -> if not @@ predicate old_rep then - old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (*we keep the same representative as before*) - (* the representative need to be removed from the data structure: state is the new repr.*) + old_rep, old_z, TMap.add old_rep (old_rep, Z.zero) new_reps else (* <- we keep the same representative as before *) + (* the representative need to be removed from the data structure: state is the new repr->*) state, Z.zero, TMap.add old_rep (state, old_z) new_reps in let add_atom (uf, new_reps, new_cc, reachable_old_reps) state = let old_rep, old_z, uf = TUF.find uf state in @@ -984,7 +960,7 @@ let remove_terms_from_eq predicate cc = ) term_set; !res with Found -> !res in - (* find successor term -> find any element in equivalence class that can be dereferenced *) + (* find successor term -> find any element in equivalence class that can be dereferenced *) match List.find_map_opt find_successor_in_set (ZMap.bindings @@ TMap.find old_rep cmap) with | Some successor_term -> if (not @@ predicate successor_term && T.check_valid_pointer (T.to_cil successor_term)) then let new_cc = insert_terms new_cc [successor_term] in @@ -992,7 +968,7 @@ let remove_terms_from_eq predicate cc = | Some (new_rep_s,z2) -> (* the successor already has a new representative, therefore we can just add it to the lookup map*) uf, new_reps, closure new_cc [(successor_term, new_rep_s, Z.(old_z_s-z2))], reachable_old_reps | None -> (* the successor state was not visited yet, therefore we need to find the new representative of the state. - -> we choose a successor term *(t+z) for any + -> we choose a successor term *(t+z) for any t -> we need add the successor state to the list of states that still need to be visited *) uf, TMap.add old_rep_s (successor_term, old_z_s) new_reps, new_cc, (old_rep_s, successor_term, old_z_s)::reachable_old_reps @@ -1063,12 +1039,11 @@ let remove_terms predicate cc = let remove_terms p cc = Timing.wrap "removing terms" (remove_terms p) cc -(* join version 1: by using the automaton *) - let show_pmap pmap= List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) +(** Join version 1: by using the automaton. *) let join_eq cc1 cc2 = let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in let mappings = List.map @@ -1104,8 +1079,7 @@ let join_eq cc1 cc2 = in add_edges_to_map pmap cc working_set -(* join version 2: just look at equivalence classes and not the automaton. *) - +(** Join version 2: just look at equivalence classes and not the automaton. *) let product_no_automata_over_terms cc1 cc2 terms = let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in let mappings = List.map @@ -1119,10 +1093,8 @@ let product_no_automata_over_terms cc1 cc2 terms = add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in List.fold_left add_term (Some init_cc, Map.empty) mappings -(** Here we do the join without using the automata, because apparently - we don't want to describe the automaton in the paper... - - We construct a new cc that contains the elements of cc1.set U cc2.set +(** Here we do the join without using the automata. + We construct a new cc that contains the elements of cc1.set U cc2.set. and two elements are in the same equivalence class iff they are in the same eq. class both in cc1 and in cc2. *) let join_eq_no_automata cc1 cc2 = @@ -1149,24 +1121,22 @@ let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. - This is done by checing for each block disequality if it is implied by both cc. *) + This is done by checking for each block disequality if it is implied by both cc. *) let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = let bldiseq1 = BlDis.to_conj bldiseq1 in let bldiseq2 = BlDis.to_conj bldiseq2 in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1 cc.uf) in - let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2 cc.uf) in + let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1) in + let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2) in let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); {cc with bldis} -(* Check for equality of two congruence closures, - by comparing the equivalence classes instead of computing the minimal_representative. *) - -(** Compares the equivalence classes of cc1 and those of cc2. *) +(** Check for equality of two congruence closures, + by comparing the equivalence classes instead of computing the minimal_representative. *) let equal_eq_classes cc1 cc2 = let comp1, comp2 = fst(Disequalities.comp_map cc1.uf), fst(Disequalities.comp_map cc2.uf) in (* they should have the same number of equivalence classes *) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 031667962e..bd2e3feb8f 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -1,4 +1,8 @@ - +(** + The Union Find is used by the C-2PO Analysis. + This file contains the code for a quantitative union find and the quantitative finite automata. + They will be necessary in order to construct the congruence closure of terms. +*) open Batteries open GoblintCil open DuplicateVars @@ -726,4 +730,14 @@ module LookupMap = struct match find_opt v map with | None -> [] | Some zmap -> zmap_bindings zmap + + (** Find all elements that are in the same equivalence class as t, + given the cmap. *) + let comp_t_cmap_repr cmap t = + match TMap.find_opt t cmap with + | None -> [Z.zero, t] + | Some zmap -> + List.concat_map + (fun (z, set) -> + List.cartesian_product [z] (TSet.to_list set)) (ZMap.bindings zmap) end From 89ec5e20e80d0ae18128fa2a541f91b39105bbe5 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 8 Aug 2024 11:26:04 +0200 Subject: [PATCH 303/323] update comments --- src/analyses/c2poAnalysis.ml | 20 +++++++++------- src/analyses/singleThreadedLifter.ml | 3 ++- src/analyses/startStateAnalysis.ml | 8 +++---- src/cdomains/c2poDomain.ml | 12 +++++----- src/cdomains/congruenceClosure.ml | 36 ++++++++++++++++++++++++---- src/cdomains/duplicateVars.ml | 5 +++- 6 files changed, 57 insertions(+), 27 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index c09549f546..f581429b6a 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -1,4 +1,4 @@ -(** A Weakly-Relational Pointer Analysis. The analysis can infer equalities and disequalities between terms which are built from pointer variables, with the addition of constants and dereferencing. ([c2po])*) +(** C-2PO: A Weakly-Relational Pointer Analysis for C based on 2 Pointer Logic. The analysis can infer equalities and disequalities between terms which are built from pointer variables, with the addition of constants and dereferencing. ([c2po])*) open Analyses open GoblintCil @@ -18,7 +18,7 @@ struct let name () = "c2po" let startcontext () = D.empty () - (* find reachable variables in a function *) + (** Find reachable variables in a function *) let reachable_from_args ctx args = let res = List.fold (fun vs e -> vs @ (ctx.ask (ReachableFrom e) |> Queries.AD.to_var_may)) [] args in @@ -37,6 +37,7 @@ struct in if M.tracing then M.trace "c2po" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res + (**Convert a conjunction to an invariant.*) let conj_to_invariant ask conjs t = List.fold (fun a prop -> match T.prop_to_cil prop with | exception (T.UnsupportedCilExpression _) -> a @@ -63,6 +64,8 @@ struct end | _ -> Result.top q + (** Assign the term `lterm` to the right hand side rhs, that is already + converted to a C-2PO term. *) let assign_term t ask lterm rhs lval_t = (* ignore assignments to values that are not 64 bits *) match T.get_element_size_in_bits lval_t, rhs with @@ -78,6 +81,8 @@ struct D.remove_terms_containing_variable @@ AssignAux lval_t | _ -> (* this is impossible *) D.top () + (** Assign Cil Lval to a right hand side that is already converted to + C-2PO terms.*) let assign_lval t ask lval expr = let lval_t = typeOfLval lval in match T.of_lval ask lval with @@ -151,10 +156,10 @@ struct branch ctx exp true | _ -> reset_normal_form t - (*First all local variables of the function are duplicated (by negating their ID), - then we remember the value of each local variable at the beginning of the function - by using the analysis startState. This way we can infer the relations between the - local variables of the caller and the pointers that were modified by the function. *) + (**First all local variables of the function are duplicated (by negating their ID), + then we remember the value of each local variable at the beginning of the function + by using the analysis startState. This way we can infer the relations between the + local variables of the caller and the pointers that were modified by the function. *) let enter ctx var_opt f args = (* add duplicated variables, and set them equal to the original variables *) let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (DuplicVar v), T.term_of_varinfo (NormalVar v), Z.zero)) f.sformals) in @@ -173,8 +178,6 @@ struct let duplicated_vars = f.sformals in D.remove_terms_containing_variables (ReturnAux (TVoid [])::Var.from_varinfo local_vars duplicated_vars) t - (*ctx caller, t callee, ask callee, t_context_opt context vom callee -> C.t - expr funktionsaufruf*) let combine_env ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = let og_t = t in (* assign function parameters to duplicated values *) @@ -190,7 +193,6 @@ struct let t = reset_normal_form @@ remove_out_of_scope_vars t f in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t - (*ctx.local is after combine_env, t callee*) let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = (* assign function parameters to duplicated values *) let arg_assigns = GobList.combine_short f.sformals args in diff --git a/src/analyses/singleThreadedLifter.ml b/src/analyses/singleThreadedLifter.ml index 5253caef56..65b72a6d9c 100644 --- a/src/analyses/singleThreadedLifter.ml +++ b/src/analyses/singleThreadedLifter.ml @@ -1,4 +1,5 @@ -(** A 2-pointer analysis for C. I made this in a few days so please don't judge the code quality. ([2cpo])*) +(** This lifter transforms any analysis into a single threaded analysis by returning top when the code might be multi-threaded. +*) open Analyses diff --git a/src/analyses/startStateAnalysis.ml b/src/analyses/startStateAnalysis.ml index 2964fe114d..551034e3bd 100644 --- a/src/analyses/startStateAnalysis.ml +++ b/src/analyses/startStateAnalysis.ml @@ -1,12 +1,12 @@ (** Remembers the abstract address value of each parameter at the beginning of each function by adding a ghost variable for each parameter. - Used by the c2po anaylysis. *) + Used by the c2po analysis. *) open GoblintCil open Batteries open Analyses open DuplicateVars.Var -(*First all parameters (=formals) of the function are duplicated (by negating their ID), +(**First all parameters (=formals) of the function are duplicated (by using DuplicateVars), then we remember the value of each local variable at the beginning of the function in this new duplicated variable. *) module Spec : Analyses.MCPSpec = @@ -27,8 +27,7 @@ struct let get_value (ask: Queries.ask) exp = ask_may_point_to ask exp - (** If e is a known variable, then it returns the value for this variable. - If e is &x' for a duplicated variable x' of x, then it returns MayPointTo of &x. + (** If e is a known variable (=one of the duplicated variables), then it returns the value for this variable. If e is an unknown variable or an expression that is not simply a variable, then it returns top. *) let eval (ask: Queries.ask) (d: D.t) (exp: exp): Value.t = match exp with | Lval (Var x, NoOffset) -> begin match D.find_opt x d with @@ -45,7 +44,6 @@ struct let open Queries in match q with | MayPointTo e -> eval (ask_of_ctx ctx) ctx.local e - | EvalValue e -> Address (eval (ask_of_ctx ctx) ctx.local e) | _ -> Result.top q let body ctx (f:fundec) = diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index dcac36391c..aa97480f2b 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -1,4 +1,4 @@ -(** Domain for weakly relational pointer analysis. *) +(** Domain for weakly relational pointer analysis C-2PO. *) open Batteries open GoblintCil @@ -196,7 +196,7 @@ module D = struct (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", - except the global vars are also keeped (when vstorage = static), + except the global vars are also kept (when vglob = true), while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^Var.show v) "" vars); @@ -210,10 +210,10 @@ module D = struct Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) (** Remove terms from the data structure. - It removes all terms that may point to the same address as "tainted".*) - let remove_tainted_terms ask address cc = - if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask address cc) cc) + It removes all terms that may point to one of the tainted adresses.*) + let remove_tainted_terms ask adress cc = + if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty adress; + Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask adress cc) cc) (** Remove terms from the data structure. It removes all terms that are not in the scope, and also those that are tmp variables.*) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 1b5441cf58..42d755fc5e 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -42,7 +42,7 @@ module BlDis = struct (** params: - t1-> a term that is NOT present in the data structure + t1-> a term that is not necessarily present in the data structure tlist: a list of representative terms @@ -164,7 +164,7 @@ module Disequalities = struct ) ([],uf) (TMap.bindings uf)) - (** arg: + (** Returns: "arg" map: maps each representative term t to a map that maps an integer Z to a list of representatives t' of v where *(v + z') is @@ -535,6 +535,23 @@ struct let hash x y = 0 end +(** + This is the type for the abstract domain. + + - `uf` is the union find tree + + - `set` is the set of terms that are currently considered. + It is the set of terms that have a mapping in the `uf` tree. + + - `map` maps reference variables v to a map that maps integers z to terms that are equivalent to *(v + z). + It represents the transitions of the quantitative finite automata. + + - `normal_form` is the unique normal form of the domain element, it is a lazily computed when needed and stored such that it can be used again later. + + - `diseq` represents the block disequalities. It is a map that maps each term to a set of terms that are definitely in a different block. + + - `bldis` represents the disequalities. It is a map from a term t1 to a map from an integer z to a set of terms T, which represents the disequality t1 != z + t2 for each t2 in T. +*) type t = {uf: TUF.t; set: SSet.t; map: LMap.t; @@ -921,6 +938,7 @@ let add_block_diseqs cc lterm = (* Remove variables: *) +(** Removes terms from the union find and the lookup map. *) let remove_terms_from_eq predicate cc = let insert_terms cc = List.fold (fun cc t -> snd (insert cc t)) cc in (* start from all initial states that are still valid and find new representatives if necessary *) @@ -1043,7 +1061,9 @@ let show_pmap pmap= List.fold_left (fun s ((r1,r2,z1),(t,z2)) -> s ^ ";; " ^ "("^T.show r1^","^T.show r2 ^ ","^Z.to_string z1^") --> ("^ T.show t ^ Z.to_string z2 ^ ")") ""(Map.bindings pmap) -(** Join version 1: by using the automaton. *) +(** Join version 1: by using the automaton. + The product automaton of cc1 and cc2 is computed and then we add the terms to the right equivalence class. We also add new terms in order to have some terms for each state in + the automaton. *) let join_eq cc1 cc2 = let atoms = SSet.get_atoms (SSet.inter cc1.set cc2.set) in let mappings = List.map @@ -1207,11 +1227,14 @@ module MayBeEqual = struct | exception (IntDomain.ArithmeticOnIntegerBot _) -> AD.top () | res -> res + (** Ask MayPointTo not only for the term `term`, but also + for all terms that are in the same equivalence class as `term`. Then meet the result. + *) let may_point_to_all_equal_terms ask exp cc term offset = let equal_terms = if TMap.mem term cc.uf then let comp = Disequalities.comp_t cc.uf term in let valid_term (t,z) = - T.is_ptr_type (T.type_of_term t) && (to_varinfo (T.get_var t)).vid > 0 in + T.is_ptr_type (T.type_of_term t) in List.filter valid_term comp else [(term,Z.zero)] in @@ -1229,7 +1252,7 @@ module MayBeEqual = struct in List.fold intersect_query_result (AD.top()) equal_terms - (**Find out if two addresses are possibly equal by using the MayPointTo query. *) + (**Find out if an addresse is possibly equal to one of the adresses in `adresses` by using the MayPointTo query. *) let may_point_to_address (ask:Queries.ask) adresses t2 off cc = match T.to_cil_sum off (T.to_cil t2) with | exception (T.UnsupportedCilExpression _) -> true @@ -1242,6 +1265,7 @@ module MayBeEqual = struct if M.tracing then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt2: %s; exp2: %a; res: %a; \nmeet: %a; result: %s\n" AD.pretty mpt1 (T.show t2) d_plainexp exp2 AD.pretty mpt2 AD.pretty (try AD.meet mpt1 mpt2 with IntDomain.ArithmeticOnIntegerBot _ -> AD.bot ()) (string_of_bool res); res + (** Find out if two addresses `t1` and `t2` are possibly equal by using the MayPointTo query. *) let may_point_to_same_address (ask:Queries.ask) t1 t2 off cc = if T.equal t1 t2 then true else let exp1 = T.to_cil t1 in @@ -1250,6 +1274,7 @@ module MayBeEqual = struct if M.tracing && res then M.tracel "c2po-maypointto2" "QUERY MayPointTo. \nres: %a;\nt1: %s; exp1: %a;\n" AD.pretty mpt1 (T.show t1) d_plainexp exp1; res + (** Returns true if `t1` and `t2` may possibly be equal or may possibly overlap. *) let rec may_be_equal ask cc s t1 t2 = let there_is_an_overlap s s' diff = if Z.(gt diff zero) then Z.(lt diff s') else Z.(lt (-diff) s) @@ -1282,6 +1307,7 @@ module MayBeEqual = struct if M.tracing then M.tracel "c2po-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res + (**Returns true if `t2` or any subterm of `t2` may possibly point to one of the adresses in `adresses`.*) let rec may_point_to_one_of_these_adresses ask adresses cc t2 = match t2 with | Deref (v, z',_) -> diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index 8ce0d7b90e..a70f98634c 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -1,3 +1,7 @@ +(** Used by C2poDomain and StartStateAnalysis. + Contains functions to duplicate variables in order to have shadow variables for each function parameter, + that can be used to remeber the initial value of these parameters. + It uses RichVarinfo to create the duplicated variables. *) open CilType open GoblintCil open Batteries @@ -40,7 +44,6 @@ end module VarVarinfoMap = RichVarinfo.BiVarinfoMap.Make(VarType) - module Var = struct include VarType From 5d940cd4ffce847e81e3f1e757c74fd8d1b76551 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Thu, 8 Aug 2024 11:33:07 +0200 Subject: [PATCH 304/323] adress -> address --- src/cdomains/c2poDomain.ml | 8 ++++---- src/cdomains/congruenceClosure.ml | 16 ++++++++-------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index aa97480f2b..b9f31c8c0c 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -210,10 +210,10 @@ module D = struct Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) (** Remove terms from the data structure. - It removes all terms that may point to one of the tainted adresses.*) - let remove_tainted_terms ask adress cc = - if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty adress; - Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_adresses ask adress cc) cc) + It removes all terms that may point to one of the tainted addresses.*) + let remove_tainted_terms ask address cc = + if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; + Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_addresses ask address cc) cc) (** Remove terms from the data structure. It removes all terms that are not in the scope, and also those that are tmp variables.*) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 42d755fc5e..300ad444a1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -1252,12 +1252,12 @@ module MayBeEqual = struct in List.fold intersect_query_result (AD.top()) equal_terms - (**Find out if an addresse is possibly equal to one of the adresses in `adresses` by using the MayPointTo query. *) - let may_point_to_address (ask:Queries.ask) adresses t2 off cc = + (**Find out if an addresse is possibly equal to one of the addresses in `addresses` by using the MayPointTo query. *) + let may_point_to_address (ask:Queries.ask) addresses t2 off cc = match T.to_cil_sum off (T.to_cil t2) with | exception (T.UnsupportedCilExpression _) -> true | exp2 -> - let mpt1 = adresses in + let mpt1 = addresses in let mpt2 = may_point_to_all_equal_terms ask exp2 cc t2 off in let res = try not (AD.is_bot (AD.meet mpt1 mpt2)) with IntDomain.ArithmeticOnIntegerBot _ -> true @@ -1307,12 +1307,12 @@ module MayBeEqual = struct if M.tracing then M.tracel "c2po-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; res - (**Returns true if `t2` or any subterm of `t2` may possibly point to one of the adresses in `adresses`.*) - let rec may_point_to_one_of_these_adresses ask adresses cc t2 = + (**Returns true if `t2` or any subterm of `t2` may possibly point to one of the addresses in `addresses`.*) + let rec may_point_to_one_of_these_addresses ask addresses cc t2 = match t2 with | Deref (v, z',_) -> - (may_point_to_address ask adresses v z' cc) - || (may_point_to_one_of_these_adresses ask adresses cc v) + (may_point_to_address ask addresses v z' cc) + || (may_point_to_one_of_these_addresses ask addresses cc v) | Addr _ -> false - | Aux (v,e) -> may_point_to_address ask adresses (Addr v) Z.zero cc + | Aux (v,e) -> may_point_to_address ask addresses (Addr v) Z.zero cc end From 30949fda80f7af937842f7b4b961f23d636d3ae7 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 13 Aug 2024 10:50:15 +0200 Subject: [PATCH 305/323] remove unused polymorphism --- src/cdomains/unionFind.ml | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index bd2e3feb8f..f20ebaa6e2 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -10,9 +10,13 @@ module M = Messages exception Unsat -type ('v, 't) term = Addr of 'v | Aux of 'v * 't | Deref of ('v, 't) term * Z.t * 't [@@deriving eq, ord, hash] -type ('v, 't) prop = Equal of ('v, 't) term * ('v, 't) term * Z.t | Nequal of ('v, 't) term * ('v, 't) term * Z.t - | BlNequal of ('v, 't) term * ('v, 't) term +(* equality of terms should not depend on the expression *) +let compare_exp _ _ = 0 +let equal_exp _ _ = true +let hash_exp _ = 1 +type term = Addr of Var.t | Aux of Var.t * (exp[@compare.ignore][@eq.ignore][@hash.ignore]) | Deref of term * Z.t * (exp[@compare.ignore][@eq.ignore][@hash.ignore]) [@@deriving eq, ord, hash] +type prop = Equal of term * term * Z.t | Nequal of term * term * Z.t + | BlNequal of term * term [@@deriving eq, ord, hash] (** The terms consist of address constants and dereferencing function with sum of an integer. @@ -25,14 +29,9 @@ module T = struct let bitsSizeOfPtr () = Z.of_int @@ bitsSizeOf (TPtr (TVoid [],[])) - (* equality of terms should not depend on the expression *) - let compare_exp _ _ = 0 - let equal_exp _ _ = true - let hash_exp _ = 1 - (* we store the varinfo and the Cil expression corresponding to the term in the data type *) - type t = (Var.t, exp[@compare.ignore][@eq.ignore][@hash.ignore]) term [@@deriving eq, ord, hash] - type v_prop = (Var.t, exp[@hash.ignore]) prop [@@deriving hash] + type t = term [@@deriving eq, ord, hash] + type v_prop = prop [@@deriving hash] let compare t1 t2 = match t1,t2 with From b3ea84526409d5e9c849fbc2da143a8341674efc Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 13 Aug 2024 10:55:03 +0200 Subject: [PATCH 306/323] remove redundant compare --- src/cdomains/unionFind.ml | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index f20ebaa6e2..63a86a2687 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -33,16 +33,6 @@ module T = struct type t = term [@@deriving eq, ord, hash] type v_prop = prop [@@deriving hash] - let compare t1 t2 = - match t1,t2 with - | Addr v1, Addr v2 - | Aux (v1,_), Aux (v2,_) -> Var.compare v1 v2 - | Deref (t1,z1,_), Deref (t2,z2,_) -> let c = compare t1 t2 in - if c = 0 then Z.compare z1 z2 else c - | Addr _, _ - | _, Deref _ -> -1 - | _ -> 1 - let normal_form_prop = function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> if compare t1 t2 < 0 || (compare t1 t2 = 0 && Z.geq z Z.zero) then (t1,t2,z) else From da75386e1d1aa654a1413c1498b063337af1f1d4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 13 Aug 2024 11:13:44 +0200 Subject: [PATCH 307/323] use Cilfacade.isFloatType snf Cil.unrollType --- src/cdomains/unionFind.ml | 33 +++++++++++---------------------- 1 file changed, 11 insertions(+), 22 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 63a86a2687..91e15dcad5 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -134,8 +134,7 @@ module T = struct (** Returns Some type for a pointer to a type and None if the result is not a pointer. *) let rec type_of_element typ = - match typ with - | TNamed (typinfo, _) -> type_of_element typinfo.ttype + match Cil.unrollType typ with | TArray (typ, _, _) -> type_of_element typ | TPtr (typ, _) -> Some typ | _ -> None @@ -148,31 +147,21 @@ module T = struct | Some typ -> get_size_in_bits typ | None -> Z.one - let rec is_array_type = function - | TNamed (typinfo, _) -> is_array_type typinfo.ttype - | TArray _ -> true - | _ -> false - - let rec is_struct_type = function - | TNamed (typinfo, _) -> is_struct_type typinfo.ttype + let is_struct_type t = + match Cil.unrollType t with | TComp _ -> true | _ -> false - let rec is_struct_ptr_type = function - | TNamed (typinfo, _) -> is_struct_ptr_type typinfo.ttype + let is_struct_ptr_type t = + match Cil.unrollType t with | TPtr(typ,_) -> is_struct_type typ | _ -> false - let rec is_ptr_type = function - | TNamed (typinfo, _) -> is_ptr_type typinfo.ttype + let is_ptr_type t = + match Cil.unrollType t with | TPtr _ -> true | _ -> false - let rec is_float = function - | TNamed (typinfo, _) -> is_float typinfo.ttype - | TFloat _ -> true - | _ -> false - let aux_term_of_varinfo vinfo = Aux (vinfo, Lval (Var (Var.to_varinfo vinfo), NoOffset)) @@ -223,8 +212,8 @@ module T = struct | exception (SizeOfError _) -> if M.tracing then M.trace "c2po-invalidate" "REASON: unknown offset"; raise (UnsupportedCilExpression "unknown offset") - let rec can_be_dereferenced = function - | TNamed (typinfo, _) -> can_be_dereferenced typinfo.ttype + let can_be_dereferenced t = + match Cil.unrollType t with | TPtr _| TArray _| TComp _ -> true | _ -> false @@ -289,7 +278,7 @@ module T = struct match typeOf term with (* we want to make sure that the expression is valid *) | exception GoblintCil__Errormsg.Error -> false | typ -> (* we only track equalties between pointers (variable of size 64)*) - if get_size_in_bits typ <> bitsSizeOfPtr () || is_float typ then false + if get_size_in_bits typ <> bitsSizeOfPtr () || Cilfacade.isFloatType typ then false else true (** Only keeps the variables that are actually pointers (or 64-bit integers). *) @@ -412,7 +401,7 @@ module T = struct (** Converts the negated expression to a term if neg = true. If neg = false then it simply converts the expression to a term. *) let of_cil_neg ask neg e = - match is_float (typeOf e) with + match Cilfacade.isFloatType (typeOf e) with | exception GoblintCil__Errormsg.Error | true -> None, None | false -> let res = match of_cil_neg ask neg (Cil.constFold false e) with From 448768e9691c263ab9ba48f3eeb164daebe35e1b Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 13 Aug 2024 11:23:48 +0200 Subject: [PATCH 308/323] change error to TypoOfError --- src/cdomains/unionFind.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 91e15dcad5..93c1b6c2a0 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -276,7 +276,7 @@ module T = struct that has the same size as a pointer.*) let check_valid_pointer term = match typeOf term with (* we want to make sure that the expression is valid *) - | exception GoblintCil__Errormsg.Error -> false + | exception Cilfacade.TypeOfError _ -> false | typ -> (* we only track equalties between pointers (variable of size 64)*) if get_size_in_bits typ <> bitsSizeOfPtr () || Cilfacade.isFloatType typ then false else true @@ -402,7 +402,8 @@ module T = struct If neg = false then it simply converts the expression to a term. *) let of_cil_neg ask neg e = match Cilfacade.isFloatType (typeOf e) with - | exception GoblintCil__Errormsg.Error | true -> None, None + | exception Cilfacade.TypeOfError _ + | true -> None, None | false -> let res = match of_cil_neg ask neg (Cil.constFold false e) with | exception (UnsupportedCilExpression s) -> if M.tracing then M.trace "c2po-cil-conversion" "unsupported exp: %a\n%s\n" d_plainexp e s; From eabeec9d7ba172cb06667c8a5079d783e07e9f7a Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 13 Aug 2024 11:38:51 +0200 Subject: [PATCH 309/323] explain better what singleThreadedLifter is for --- src/analyses/singleThreadedLifter.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/singleThreadedLifter.ml b/src/analyses/singleThreadedLifter.ml index 65b72a6d9c..bda1881858 100644 --- a/src/analyses/singleThreadedLifter.ml +++ b/src/analyses/singleThreadedLifter.ml @@ -1,4 +1,4 @@ -(** This lifter transforms any analysis into a single threaded analysis by returning top when the code might be multi-threaded. +(** This lifter takes an analysis that only works for single-threaded code and allows it to run on multi-threaded programs by returning top when the code might be multi-threaded. *) open Analyses From 1e5e645b08037b554d70b9c499f1f80987e78c03 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 13 Aug 2024 11:41:14 +0200 Subject: [PATCH 310/323] do not recompute compare --- src/cdomains/unionFind.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 93c1b6c2a0..1a522d127d 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -35,7 +35,8 @@ module T = struct let normal_form_prop = function | Equal (t1,t2,z) | Nequal (t1,t2,z) -> - if compare t1 t2 < 0 || (compare t1 t2 = 0 && Z.geq z Z.zero) then (t1,t2,z) else + let cmp = compare t1 t2 in + if cmp < 0 || (cmp = 0 && Z.geq z Z.zero) then (t1,t2,z) else (t2,t1,Z.(-z)) | BlNequal (t1,t2) -> if compare t1 t2 < 0 then (t1,t2,Z.zero) else From f6133c94c792c407b6404a4ad4e151c74ae6e2e3 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 9 Sep 2024 12:42:43 +0200 Subject: [PATCH 311/323] fix invariant generation bug --- src/cdomains/congruenceClosure.ml | 5 ++++- src/cdomains/unionFind.ml | 7 +++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 300ad444a1..c9a59e1df1 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -424,7 +424,10 @@ module SSet = struct | result -> result | exception (T.UnsupportedCilExpression _) -> let random_type = (TPtr (TPtr (TInt (ILong,[]),[]),[])) in (*the type is not so important for min_repr and get_normal_form*) - Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), T.to_cil_constant z (Some random_type), random_type)), NoOffset)) + let cil_off = match T.to_cil_constant z (Some random_type) with + | exception (T.UnsupportedCilExpression _) -> Const (CInt (Z.zero, T.default_int_type, Some (Z.to_string z))) + | exp -> exp in + Deref (min_term, z, Lval (Mem (BinOp (PlusPI, T.to_cil(min_term), cil_off, random_type)), NoOffset)) end diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 1a522d127d..314a33ecc0 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -236,6 +236,7 @@ module T = struct | Some t -> get_element_size_in_bits t | None -> Z.one in + if Z.lt (Z.abs z) typ_size && Z.gt (Z.abs z) Z.zero then raise (UnsupportedCilExpression "Cil can't represent something like &(c->d).") else if Z.equal typ_size Z.zero then Z.zero else Z.(z /typ_size) in Const (CInt (z, default_int_type, Some (Z.to_string z))) @@ -243,10 +244,8 @@ module T = struct let to_cil_sum off cil_t = let res = if Z.(equal zero off) then cil_t else - match typeOf cil_t with - | TPtr (TComp (cinfo, _), _) -> raise (UnsupportedCilExpression "Cil can't represent something like &(c->d).") - | typ -> - BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) + let typ = typeOf cil_t in + BinOp (PlusPI, cil_t, to_cil_constant off (Some typ), typ) in if M.tracing then M.trace "c2po-2cil" "exp: %a; offset: %s; res: %a" d_exp cil_t (Z.to_string off) d_exp res;res (** Returns the integer offset of a field of a struct. *) From 599dfd462f80ea6f963116139ce4a4a7345ad38e Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 9 Sep 2024 12:49:45 +0200 Subject: [PATCH 312/323] remove confs --- conf/svcomp-c2po-no-maypointto.json | 152 --------------------------- conf/svcomp-c2po1_join_nform.json | 154 ---------------------------- conf/svcomp-c2po2_nform.json | 154 ---------------------------- conf/svcomp-c2po3_join.json | 154 ---------------------------- conf/svcomp-c2po4.json | 154 ---------------------------- conf/svcomp-no-var-eq.json | 146 -------------------------- 6 files changed, 914 deletions(-) delete mode 100644 conf/svcomp-c2po-no-maypointto.json delete mode 100644 conf/svcomp-c2po1_join_nform.json delete mode 100644 conf/svcomp-c2po2_nform.json delete mode 100644 conf/svcomp-c2po3_join.json delete mode 100644 conf/svcomp-c2po4.json delete mode 100644 conf/svcomp-no-var-eq.json diff --git a/conf/svcomp-c2po-no-maypointto.json b/conf/svcomp-c2po-no-maypointto.json deleted file mode 100644 index 2d3b8feffa..0000000000 --- a/conf/svcomp-c2po-no-maypointto.json +++ /dev/null @@ -1,152 +0,0 @@ -{ - "ana": { - "sv-comp": { - "enabled": true, - "functions": true - }, - "int": { - "def_exc": true, - "enums": false, - "interval": true - }, - "float": { - "interval": true - }, - "activated": [ - "base", - "threadid", - "threadflag", - "threadreturn", - "mallocWrapper", - "mutexEvents", - "mutex", - "access", - "race", - "escape", - "expRelation", - "mhp", - "assert", - "symb_locks", - "region", - "thread", - "threadJoins", - "c2po", - "startState", - "taintPartialContexts" - ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], - "context": { - "widen": false - }, - "malloc": { - "wrappers": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", - "kzalloc", - - "ldv_malloc", - - "kzalloc_node", - "ldv_zalloc", - "kmalloc_array", - "kcalloc", - - "ldv_xmalloc", - "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" - ] - }, - "base": { - "arrays": { - "domain": "partitioned" - } - }, - "race": { - "free": false, - "call": false - }, - "c2po": { - "askbase": false - }, - "autotune": { - "enabled": true, - "activated": [ - "singleThreaded", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "congruence", - "octagon", - "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false, - "call": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } - } diff --git a/conf/svcomp-c2po1_join_nform.json b/conf/svcomp-c2po1_join_nform.json deleted file mode 100644 index 73037d685c..0000000000 --- a/conf/svcomp-c2po1_join_nform.json +++ /dev/null @@ -1,154 +0,0 @@ -{ - "ana": { - "sv-comp": { - "enabled": true, - "functions": true - }, - "int": { - "def_exc": true, - "enums": false, - "interval": true - }, - "float": { - "interval": true - }, - "activated": [ - "base", - "threadid", - "threadflag", - "threadreturn", - "mallocWrapper", - "mutexEvents", - "mutex", - "access", - "race", - "escape", - "expRelation", - "mhp", - "assert", - "symb_locks", - "region", - "thread", - "threadJoins", - "c2po", - "startState", - "taintPartialContexts" - ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], - "context": { - "widen": false - }, - "malloc": { - "wrappers": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", - "kzalloc", - - "ldv_malloc", - - "kzalloc_node", - "ldv_zalloc", - "kmalloc_array", - "kcalloc", - - "ldv_xmalloc", - "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" - ] - }, - "base": { - "arrays": { - "domain": "partitioned" - } - }, - "race": { - "free": false, - "call": false - }, - "autotune": { - "enabled": true, - "activated": [ - "singleThreaded", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "congruence", - "octagon", - "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - }, - "c2po": { - "askbase": true, - "precise_join": true, - "normal_form": true - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false, - "call": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } - } diff --git a/conf/svcomp-c2po2_nform.json b/conf/svcomp-c2po2_nform.json deleted file mode 100644 index a21567475d..0000000000 --- a/conf/svcomp-c2po2_nform.json +++ /dev/null @@ -1,154 +0,0 @@ -{ - "ana": { - "sv-comp": { - "enabled": true, - "functions": true - }, - "int": { - "def_exc": true, - "enums": false, - "interval": true - }, - "float": { - "interval": true - }, - "activated": [ - "base", - "threadid", - "threadflag", - "threadreturn", - "mallocWrapper", - "mutexEvents", - "mutex", - "access", - "race", - "escape", - "expRelation", - "mhp", - "assert", - "symb_locks", - "region", - "thread", - "threadJoins", - "c2po", - "startState", - "taintPartialContexts" - ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], - "context": { - "widen": false - }, - "malloc": { - "wrappers": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", - "kzalloc", - - "ldv_malloc", - - "kzalloc_node", - "ldv_zalloc", - "kmalloc_array", - "kcalloc", - - "ldv_xmalloc", - "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" - ] - }, - "base": { - "arrays": { - "domain": "partitioned" - } - }, - "race": { - "free": false, - "call": false - }, - "autotune": { - "enabled": true, - "activated": [ - "singleThreaded", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "congruence", - "octagon", - "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - }, - "c2po": { - "askbase": true, - "precise_join": false, - "normal_form": true - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false, - "call": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } - } diff --git a/conf/svcomp-c2po3_join.json b/conf/svcomp-c2po3_join.json deleted file mode 100644 index c33a6c9820..0000000000 --- a/conf/svcomp-c2po3_join.json +++ /dev/null @@ -1,154 +0,0 @@ -{ - "ana": { - "sv-comp": { - "enabled": true, - "functions": true - }, - "int": { - "def_exc": true, - "enums": false, - "interval": true - }, - "float": { - "interval": true - }, - "activated": [ - "base", - "threadid", - "threadflag", - "threadreturn", - "mallocWrapper", - "mutexEvents", - "mutex", - "access", - "race", - "escape", - "expRelation", - "mhp", - "assert", - "symb_locks", - "region", - "thread", - "threadJoins", - "c2po", - "startState", - "taintPartialContexts" - ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], - "context": { - "widen": false - }, - "malloc": { - "wrappers": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", - "kzalloc", - - "ldv_malloc", - - "kzalloc_node", - "ldv_zalloc", - "kmalloc_array", - "kcalloc", - - "ldv_xmalloc", - "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" - ] - }, - "base": { - "arrays": { - "domain": "partitioned" - } - }, - "race": { - "free": false, - "call": false - }, - "autotune": { - "enabled": true, - "activated": [ - "singleThreaded", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "congruence", - "octagon", - "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - }, - "c2po": { - "askbase": true, - "precise_join": true, - "normal_form": false - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false, - "call": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } - } diff --git a/conf/svcomp-c2po4.json b/conf/svcomp-c2po4.json deleted file mode 100644 index 7838279e8d..0000000000 --- a/conf/svcomp-c2po4.json +++ /dev/null @@ -1,154 +0,0 @@ -{ - "ana": { - "sv-comp": { - "enabled": true, - "functions": true - }, - "int": { - "def_exc": true, - "enums": false, - "interval": true - }, - "float": { - "interval": true - }, - "activated": [ - "base", - "threadid", - "threadflag", - "threadreturn", - "mallocWrapper", - "mutexEvents", - "mutex", - "access", - "race", - "escape", - "expRelation", - "mhp", - "assert", - "symb_locks", - "region", - "thread", - "threadJoins", - "c2po", - "startState", - "taintPartialContexts" - ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], - "context": { - "widen": false - }, - "malloc": { - "wrappers": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", - "kzalloc", - - "ldv_malloc", - - "kzalloc_node", - "ldv_zalloc", - "kmalloc_array", - "kcalloc", - - "ldv_xmalloc", - "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" - ] - }, - "base": { - "arrays": { - "domain": "partitioned" - } - }, - "race": { - "free": false, - "call": false - }, - "autotune": { - "enabled": true, - "activated": [ - "singleThreaded", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "congruence", - "octagon", - "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - }, - "c2po": { - "askbase": true, - "precise_join": false, - "normal_form": false - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false, - "call": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } - } diff --git a/conf/svcomp-no-var-eq.json b/conf/svcomp-no-var-eq.json deleted file mode 100644 index e2530ea2ac..0000000000 --- a/conf/svcomp-no-var-eq.json +++ /dev/null @@ -1,146 +0,0 @@ -{ - "ana": { - "sv-comp": { - "enabled": true, - "functions": true - }, - "int": { - "def_exc": true, - "enums": false, - "interval": true - }, - "float": { - "interval": true - }, - "activated": [ - "base", - "threadid", - "threadflag", - "threadreturn", - "mallocWrapper", - "mutexEvents", - "mutex", - "access", - "race", - "escape", - "expRelation", - "mhp", - "assert", - "symb_locks", - "region", - "thread", - "threadJoins" - ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], - "context": { - "widen": false - }, - "malloc": { - "wrappers": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", - "kzalloc", - - "ldv_malloc", - - "kzalloc_node", - "ldv_zalloc", - "kmalloc_array", - "kcalloc", - - "ldv_xmalloc", - "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" - ] - }, - "base": { - "arrays": { - "domain": "partitioned" - } - }, - "race": { - "free": false, - "call": false - }, - "autotune": { - "enabled": true, - "activated": [ - "singleThreaded", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "congruence", - "octagon", - "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false, - "call": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } - } From 0d1470a2492e5e768d44d4b8c8a7572f6044fd67 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 9 Sep 2024 12:54:41 +0200 Subject: [PATCH 313/323] Revert "Horrible, horrible fix. May the gods forgive us!" This reverts commit 8173b99f25903d3ea68d7a22a042ec3bbb5a7c94. --- src/util/library/libraryDsl.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/util/library/libraryDsl.ml b/src/util/library/libraryDsl.ml index e4ce75ba8d..64684fb1ce 100644 --- a/src/util/library/libraryDsl.ml +++ b/src/util/library/libraryDsl.ml @@ -61,16 +61,16 @@ let rec accs: type k r. (k, r) args_desc -> Accesses.t = fun args_desc args -> | Some args -> (acc, arg :: args) :: List.remove_assoc acc accs'' | None -> (acc, [arg]) :: accs'' ) accs'' arg_desc.accesses - | _, _ -> [] + | _, _ -> invalid_arg "accs" let special ?(attrs:attr list=[]) args_desc special_cont = { - special = (fun args -> try Fun.flip (match_args args_desc) special_cont args with _ -> Unknown); + special = Fun.flip (match_args args_desc) special_cont; accs = accs args_desc; attrs; } let special' ?(attrs:attr list=[]) args_desc special_cont = { - special = (fun args -> try Fun.flip (match_args args_desc) (special_cont ()) args with _ -> Unknown); (* eta-expanded such that special_cont is re-executed on each call instead of once during LibraryFunctions construction *) + special = (fun args -> Fun.flip (match_args args_desc) (special_cont ()) args); (* eta-expanded such that special_cont is re-executed on each call instead of once during LibraryFunctions construction *) accs = accs args_desc; attrs; } From 85c08ec005e5969f94fa2691e2038b28cf3b34e9 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Mon, 9 Sep 2024 13:46:50 +0200 Subject: [PATCH 314/323] derive equality of propositions --- src/cdomains/congruenceClosure.ml | 9 +--- src/cdomains/unionFind.ml | 71 ++++++++++++++++--------------- 2 files changed, 38 insertions(+), 42 deletions(-) diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index c9a59e1df1..0275e5bd94 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -563,15 +563,8 @@ type t = {uf: TUF.t; bldis: BlDis.t} [@@deriving eq, ord, hash] -let string_of_prop = function - | Equal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " = " ^ T.show t2 - | Equal (t1,t2,r) -> T.show t1 ^ " = " ^ Z.to_string r ^ "+" ^ T.show t2 - | Nequal (t1,t2,r) when Z.equal r Z.zero -> T.show t1 ^ " != " ^ T.show t2 - | Nequal (t1,t2,r) -> T.show t1 ^ " != " ^ Z.to_string r ^ "+" ^ T.show t2 - | BlNequal (t1,t2) -> "bl(" ^ T.show t1 ^ ") != bl(" ^ T.show t2 ^ ")" - let show_conj list = List.fold_left - (fun s d -> s ^ "\t" ^ string_of_prop d ^ ";\n") "" list + (fun s d -> s ^ "\t" ^ T.show_prop d ^ ";\n") "" list (** Returns a list of all the transition that are present in the automata. *) let get_transitions (uf, map) = diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 314a33ecc0..6b7c6d14f8 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -14,10 +14,31 @@ exception Unsat let compare_exp _ _ = 0 let equal_exp _ _ = true let hash_exp _ = 1 -type term = Addr of Var.t | Aux of Var.t * (exp[@compare.ignore][@eq.ignore][@hash.ignore]) | Deref of term * Z.t * (exp[@compare.ignore][@eq.ignore][@hash.ignore]) [@@deriving eq, ord, hash] -type prop = Equal of term * term * Z.t | Nequal of term * term * Z.t - | BlNequal of term * term -[@@deriving eq, ord, hash] + +type term = Addr of Var.t | Aux of Var.t * exp | Deref of term * Z.t * exp [@@deriving eq, hash, ord] + +let normal_form_tuple_3 (t1,t2,z) = + let cmp = compare_term t1 t2 in + if cmp < 0 || (cmp = 0 && Z.geq z Z.zero) then (t1,t2,z) else + (t2,t1,Z.(-z)) + +let normal_form_tuple_2 (t1,t2) = + if compare_term t1 t2 < 0 then (t1,t2) else + (t2,t1) + +(** Two propositions are equal if they are syntactically equal + or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) +let tuple3_equal p1 p2 = Tuple3.eq equal_term equal_term Z.equal (normal_form_tuple_3 p1) (normal_form_tuple_3 p2) +let tuple3_cmp p1 p2 = Tuple3.comp compare_term compare_term Z.compare (normal_form_tuple_3 p1) (normal_form_tuple_3 p2) +let tuple3_hash p1 = Hashtbl.hash (normal_form_tuple_3 p1) +let tuple2_equal p1 p2 = Tuple2.eq equal_term equal_term (normal_form_tuple_2 p1) (normal_form_tuple_2 p2) +let tuple2_cmp p1 p2 = Tuple2.comp compare_term compare_term (normal_form_tuple_2 p1) (normal_form_tuple_2 p2) +let tuple2_hash p1 = Hashtbl.hash (normal_form_tuple_2 p1) + +type prop = Equal of ((term * term * Z.t) [@equal tuple3_equal][@compare tuple3_cmp][@hash tuple3_hash]) + | Nequal of ((term * term * Z.t) [@equal tuple3_equal][@compare tuple3_cmp][@hash tuple3_hash]) + | BlNequal of ((term * term) [@equal tuple2_equal][@compare tuple2_cmp][@hash tuple2_hash]) +[@@deriving eq, hash, ord] (** The terms consist of address constants and dereferencing function with sum of an integer. The dereferencing function is parametrized by the size of the element in the memory. @@ -30,36 +51,8 @@ module T = struct let bitsSizeOfPtr () = Z.of_int @@ bitsSizeOf (TPtr (TVoid [],[])) (* we store the varinfo and the Cil expression corresponding to the term in the data type *) - type t = term [@@deriving eq, ord, hash] - type v_prop = prop [@@deriving hash] - - let normal_form_prop = function - | Equal (t1,t2,z) | Nequal (t1,t2,z) -> - let cmp = compare t1 t2 in - if cmp < 0 || (cmp = 0 && Z.geq z Z.zero) then (t1,t2,z) else - (t2,t1,Z.(-z)) - | BlNequal (t1,t2) -> - if compare t1 t2 < 0 then (t1,t2,Z.zero) else - (t2,t1,Z.zero) - - (** Two propositions are equal if they are syntactically equal - or if one is t_1 = z + t_2 and the other t_2 = - z + t_1. *) - let equal_v_prop p1 p2 = - match p1, p2 with - | Equal (a,b,c), Equal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) - | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) - | BlNequal (a,b), BlNequal (a',b') -> Tuple3.eq equal equal Z.equal (normal_form_prop p1) (normal_form_prop p2) - | _ -> false - - let compare_v_prop p1 p2 = - match p1, p2 with - | Equal (a,b,c), Equal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) - | Nequal (a,b,c), Nequal (a',b',c') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) - | BlNequal (a,b), BlNequal (a',b') -> Tuple3.comp compare compare Z.compare (normal_form_prop p1) (normal_form_prop p2) - | Equal _, _ -> -1 - | _, Equal _ -> 1 - | _, BlNequal _ -> -1 - | BlNequal _ , _ -> 1 + type t = term[@@deriving eq, hash, ord] + type v_prop = prop[@@deriving eq, hash, ord] let props_equal = List.equal equal_v_prop @@ -100,6 +93,16 @@ module T = struct | Deref (t, z, exp) when Z.equal z Z.zero -> "*" ^ show t^ show_type exp | Deref (t, z, exp) -> "*(" ^ Z.to_string z ^ "+" ^ show t ^ ")"^ show_type exp + let show_prop = function + | Equal (t1,t2,r) when Z.equal r Z.zero -> show t1 ^ " = " ^ show t2 + | Equal (t1,t2,r) -> show t1 ^ " = " ^ Z.to_string r ^ "+" ^ show t2 + | Nequal (t1,t2,r) when Z.equal r Z.zero -> show t1 ^ " != " ^ show t2 + | Nequal (t1,t2,r) -> show t1 ^ " != " ^ Z.to_string r ^ "+" ^ show t2 + | BlNequal (t1,t2) -> "bl(" ^ show t1 ^ ") != bl(" ^ show t2 ^ ")" + + let equal_v_prop a b = let res = equal_v_prop a b in + print_string ((show_prop a)^"; "^(show_prop b)^"; "^string_of_bool res ^"\n"); res + (** Returns true if the first parameter is a subterm of the second one. *) let rec is_subterm st term = equal st term || match term with | Deref (t, _, _) -> is_subterm st t From 6b269fd369938f4ee3213bbb35d754b4d5ae2268 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 11:07:51 +0200 Subject: [PATCH 315/323] use Lattice.LiftBot --- src/analyses/c2poAnalysis.ml | 205 +++++++++++++++------------ src/cdomains/c2poDomain.ml | 225 +++++++++++++----------------- src/cdomains/congruenceClosure.ml | 159 ++++++++------------- 3 files changed, 269 insertions(+), 320 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index f581429b6a..a886b6f8ed 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -16,7 +16,7 @@ struct module C = D let name () = "c2po" - let startcontext () = D.empty () + let startcontext () = D.top () (** Find reachable variables in a function *) let reachable_from_args ctx args = @@ -27,20 +27,19 @@ struct (* Returns Some true if we know for sure that it is true, and Some false if we know for sure that it is false, and None if we don't know anyhing. *) - let eval_guard ask t e = + let eval_guard ask t e ik = + let open Queries in let prop_list = T.prop_of_cil ask e true in - let res = match split prop_list with - | [], [], [] -> None - | x::xs, _, [] -> if fst (eq_query t x) then Some true else if neq_query t x then Some false else None - | _, y::ys, [] -> if neq_query t y then Some true else if fst (eq_query t y) then Some false else None - | _ -> None (*there should never be block disequalities here...*) - in if M.tracing then M.trace "c2po" "EVAL_GUARD:\n Actual guard: %a; prop_list: %s; res = %s\n" - d_exp e (show_conj prop_list) (Option.map_default string_of_bool "None" res); res + match split prop_list with + | [], [], [] -> ID.top() + | x::xs, _, [] -> if fst (eq_query t x) then ID.of_bool ik true else if neq_query t x then ID.of_bool ik false else ID.top() + | _, y::ys, [] -> if neq_query t y then ID.of_bool ik true else if fst (eq_query t y) then ID.of_bool ik false else ID.top() + | _ -> ID.top() (*there should never be block disequalities here...*) (**Convert a conjunction to an invariant.*) let conj_to_invariant ask conjs t = List.fold (fun a prop -> match T.prop_to_cil prop with - | exception (T.UnsupportedCilExpression _) -> a + | exception (T.UnsupportedCilExpression _) -> a | exp -> if M.tracing then M.trace "c2po-invariant" "Adding invariant: %a" d_exp exp; Invariant.(a && of_exp exp)) @@ -48,21 +47,17 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = let open Queries in - match q with - | EvalInt e -> begin match eval_guard (ask_of_ctx ctx) ctx.local e with - | None -> Result.top q - | Some res -> - let ik = Cilfacade.get_ikind_exp e in - ID.of_bool ik res - end - | Queries.Invariant context -> - let scope = Node.find_fundec ctx.node in - begin match D.remove_vars_not_in_scope scope ctx.local with - | None -> Invariant.top() - | Some t -> - (conj_to_invariant (ask_of_ctx ctx) (get_conjunction t) (Some t)) - end - | _ -> Result.top q + match ctx.local with + | `Bot -> Result.top q + | `Lifted cc -> + match q with + | EvalInt e -> let ik = Cilfacade.get_ikind_exp e in + eval_guard (ask_of_ctx ctx) cc e ik + | Queries.Invariant context -> + let scope = Node.find_fundec ctx.node in + let t = D.remove_vars_not_in_scope scope cc in + (conj_to_invariant (ask_of_ctx ctx) (get_conjunction t) t) + | _ -> Result.top q (** Assign the term `lterm` to the right hand side rhs, that is already converted to a C-2PO term. *) @@ -70,7 +65,7 @@ struct (* ignore assignments to values that are not 64 bits *) match T.get_element_size_in_bits lval_t, rhs with (* Indefinite assignment *) - | s, (None, _) -> D.remove_may_equal_terms ask s lterm t + | s, (None, _) -> (D.remove_may_equal_terms ask s lterm t) (* Definite assignment *) | s, (Some term, Some offset) -> let dummy_var = MayBeEqual.dummy_var lval_t in @@ -79,7 +74,7 @@ struct D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> D.remove_terms_containing_variable @@ AssignAux lval_t - | _ -> (* this is impossible *) D.top () + | _ -> (* this is impossible *) C2PODomain.top () (** Assign Cil Lval to a right hand side that is already converted to C-2PO terms.*) @@ -94,19 +89,27 @@ struct Except if the left hand side is a complicated expression like myStruct.field1[i]->field2[z+k], and Goblint can't infer the offset.*) if M.tracing then M.trace "c2po-invalidate" "INVALIDATE lval: %a" d_lval lval; - D.top () + C2PODomain.top () let assign ctx lval expr = let ask = (ask_of_ctx ctx) in - let res = reset_normal_form @@ assign_lval ctx.local ask lval (T.of_cil ask expr) in - if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s. UF: %s\n" d_lval lval d_plainexp expr (D.show res) (Option.map_default (fun r -> TUF.show_uf r.uf) "None" res); res + match ctx.local with + | `Bot -> `Bot + | `Lifted cc -> + let res = `Lifted (reset_normal_form @@ assign_lval cc ask lval (T.of_cil ask expr)) in + if M.tracing then M.trace "c2po-assign" "ASSIGN: var: %a; expr: %a; result: %s.\n" d_lval lval d_plainexp expr (D.show res); res let branch ctx e pos = let props = T.prop_of_cil (ask_of_ctx ctx) e pos in let valid_props = T.filter_valid_pointers props in let res = - if List.is_empty valid_props then ctx.local else - reset_normal_form (meet_conjs_opt valid_props ctx.local) + match ctx.local with + | `Bot -> `Bot + | `Lifted t -> + if List.is_empty valid_props then `Lifted t else + match (reset_normal_form (meet_conjs_opt valid_props t)) with + | exception Unsat -> `Bot + | t -> `Lifted t in if M.tracing then M.trace "c2po" "BRANCH:\n Actual equality: %a; pos: %b; valid_prop_list: %s; is_bot: %b\n" d_exp e pos (show_conj valid_props) (D.is_bot res); @@ -123,8 +126,11 @@ struct let return ctx exp_opt f = let res = match exp_opt with - | Some e -> - assign_return (ask_of_ctx ctx) ctx.local (MayBeEqual.return_var (typeOf e)) e + | Some e -> begin match ctx.local with + | `Bot -> `Bot + | `Lifted t -> + `Lifted (assign_return (ask_of_ctx ctx) t (MayBeEqual.return_var (typeOf e)) e) + end | None -> ctx.local in if M.tracing then M.trace "c2po-function" "RETURN: exp_opt: %a; state: %s; result: %s\n" d_exp (BatOption.default (MayBeEqual.dummy_lval_print (TVoid [])) exp_opt) (D.show ctx.local) (D.show res);res @@ -132,29 +138,32 @@ struct let special ctx var_opt v exprs = let desc = LibraryFunctions.find v in let ask = ask_of_ctx ctx in - let t = begin match var_opt with - | None -> - ctx.local - | Some varin -> - (* forget information about var, - but ignore assignments to values that are not 64 bits *) - try - (let s, lterm = T.get_element_size_in_bits (typeOfLval varin), T.of_lval ask varin in - let t = D.remove_may_equal_terms ask s lterm ctx.local in - begin match desc.special exprs with - | Malloc _ | Calloc _ | Alloca _ -> - add_block_diseqs t lterm - | _ -> t - end) - with (T.UnsupportedCilExpression _) -> D.top () - end - in - match desc.special exprs with - | Assert { exp; refine; _ } -> if not refine then - ctx.local - else - branch ctx exp true - | _ -> reset_normal_form t + match ctx.local with + | `Bot -> `Bot + | `Lifted cc -> + let t = begin match var_opt with + | None -> + cc + | Some varin -> + (* forget information about var, + but ignore assignments to values that are not 64 bits *) + try + (let s, lterm = T.get_element_size_in_bits (typeOfLval varin), T.of_lval ask varin in + let t = D.remove_may_equal_terms ask s lterm cc in + begin match desc.special exprs with + | Malloc _ | Calloc _ | Alloca _ -> + add_block_diseqs t lterm + | _ -> t + end) + with (T.UnsupportedCilExpression _) -> C2PODomain.top () + end + in + match desc.special exprs with + | Assert { exp; refine; _ } -> if not refine then + ctx.local + else + branch ctx exp true + | _ -> `Lifted (reset_normal_form t) (**First all local variables of the function are duplicated (by negating their ID), then we remember the value of each local variable at the beginning of the function @@ -162,16 +171,19 @@ struct local variables of the caller and the pointers that were modified by the function. *) let enter ctx var_opt f args = (* add duplicated variables, and set them equal to the original variables *) - let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (DuplicVar v), T.term_of_varinfo (NormalVar v), Z.zero)) f.sformals) in - let state_with_duplicated_vars = meet_conjs_opt added_equalities ctx.local in - if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (D.show state_with_duplicated_vars); - (* remove callee vars that are not reachable and not global *) - let reachable_variables = - Var.from_varinfo (f.sformals @ f.slocals @ reachable_from_args ctx args) f.sformals - in - let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in - if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (D.show new_state); - [ctx.local, reset_normal_form new_state] + match ctx.local with + | `Bot -> [`Bot, `Bot] + | `Lifted cc -> + let added_equalities = T.filter_valid_pointers (List.map (fun v -> Equal (T.term_of_varinfo (DuplicVar v), T.term_of_varinfo (NormalVar v), Z.zero)) f.sformals) in + let state_with_duplicated_vars = meet_conjs_opt added_equalities cc in + if M.tracing then M.trace "c2po-function" "ENTER1: var_opt: %a; state: %s; state_with_duplicated_vars: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid [])), NoOffset) var_opt) (D.show ctx.local) (C2PODomain.show state_with_duplicated_vars); + (* remove callee vars that are not reachable and not global *) + let reachable_variables = + Var.from_varinfo (f.sformals @ f.slocals @ reachable_from_args ctx args) f.sformals + in + let new_state = D.remove_terms_not_containing_variables reachable_variables state_with_duplicated_vars in + if M.tracing then M.trace "c2po-function" "ENTER2: result: %s\n" (C2PODomain.show new_state); + [ctx.local, `Lifted (reset_normal_form new_state)] let remove_out_of_scope_vars t f = let local_vars = f.sformals @ f.slocals in @@ -179,32 +191,43 @@ struct D.remove_terms_containing_variables (ReturnAux (TVoid [])::Var.from_varinfo local_vars duplicated_vars) t let combine_env ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = - let og_t = t in - (* assign function parameters to duplicated values *) - let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (DuplicVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (D.show state_with_assignments); - (*remove all variables that were tainted by the function*) - let tainted = ask.f (MayBeTainted) - in - if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; - let local = D.remove_tainted_terms (ask_of_ctx ctx) tainted state_with_assignments in - let t = D.meet local t in - let t = reset_normal_form @@ remove_out_of_scope_vars t f in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (D.show t);t + match ctx.local with + | `Bot -> `Bot + | `Lifted cc -> + let og_t = t in + (* assign function parameters to duplicated values *) + let arg_assigns = GobList.combine_short f.sformals args in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (DuplicVar var)) (T.of_cil ask exp) var.vtype) cc arg_assigns in + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN0: state_with_assignments: %s\n" (C2PODomain.show state_with_assignments); + (*remove all variables that were tainted by the function*) + let tainted = ask.f (MayBeTainted) + in + if M.tracing then M.trace "c2po-tainted" "combine_env: %a\n" MayBeEqual.AD.pretty tainted; + let local = D.remove_tainted_terms (ask_of_ctx ctx) tainted state_with_assignments in + match D.meet (`Lifted local) t with + | `Bot -> `Bot + | `Lifted t -> + let t = reset_normal_form @@ remove_out_of_scope_vars t f in + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN1: var_opt: %a; local_state: %s; t_state: %s; meeting everything: %s\n" d_lval (BatOption.default (Var (Var.dummy_varinfo (TVoid[])), NoOffset) var_opt) (D.show ctx.local) (D.show og_t) (C2PODomain.show t); + `Lifted t let combine_assign ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = - (* assign function parameters to duplicated values *) - let arg_assigns = GobList.combine_short f.sformals args in - let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (DuplicVar var)) (T.of_cil ask exp) var.vtype) ctx.local arg_assigns in - let t = D.meet state_with_assignments t in - let t = match var_opt with - | None -> t - | Some var -> assign_lval t ask var (Some (MayBeEqual.return_var (typeOfLval var)), Some Z.zero) - in - if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (D.show_all t); - let t = reset_normal_form @@ remove_out_of_scope_vars t f - in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN3: result: %s\n" (D.show t); t + match ctx.local with + | `Bot -> `Bot + | `Lifted cc -> + (* assign function parameters to duplicated values *) + let arg_assigns = GobList.combine_short f.sformals args in + let state_with_assignments = List.fold_left (fun st (var, exp) -> assign_term st (ask_of_ctx ctx) (T.term_of_varinfo (DuplicVar var)) (T.of_cil ask exp) var.vtype) cc arg_assigns in + match D.meet (`Lifted state_with_assignments) t with + | `Bot -> `Bot + | `Lifted t -> + let t = match var_opt with + | None -> t + | Some var -> assign_lval t ask var (Some (MayBeEqual.return_var (typeOfLval var)), Some Z.zero) + in + if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN2: assigning return value: %s\n" (C2PODomain.show t); + let t = reset_normal_form @@ remove_out_of_scope_vars t f + in if M.tracing then M.trace "c2po-function" "COMBINE_ASSIGN3: result: %s\n" (C2PODomain.show t); `Lifted t let startstate v = D.top () let threadenter ctx ~multiple lval f args = [D.top ()] diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index b9f31c8c0c..6df58f5329 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -6,55 +6,39 @@ open CongruenceClosure module M = Messages open DuplicateVars -module D = struct - +module C2PODomain = struct include Printable.StdLeaf - type domain = t option [@@deriving ord, hash] - type t = domain [@@deriving ord, hash] + type t = CongruenceClosure.t[@@deriving ord, hash] - (** Convert to string *) - let show x = match x with - | None -> "⊥\n" - | Some x -> show_conj (get_conjunction x) - - let show_all = function - | None -> "⊥\n" - | Some x -> show_all x + let show x = show_conj (get_conjunction x) + let name () = "c2po" + type domain = t include Printable.SimpleShow(struct type t = domain let show = show end) - let name () = "c2po" - - let equal_standard x y = + let equal_standard cc1 cc2 = let res = - match x,y with - | None, None -> true - | Some cc1, Some cc2 -> - if exactly_equal cc1 cc2 then - true - else - (* add all terms to both elements *) - let terms = SSet.union (SSet.union cc1.set (BlDis.term_set cc1.bldis)) - (SSet.union cc2.set (BlDis.term_set cc2.bldis)) in - let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in - equal_eq_classes cc1 cc2 - && equal_diseqs cc1 cc2 - && equal_bldis cc1 cc2 - | _ -> false - in if M.tracing then M.trace "c2po-equal" "equal eq classes. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res + if exactly_equal cc1 cc2 then + true + else + (* add all terms to both elements *) + let terms = SSet.union (SSet.union cc1.set (BlDis.term_set cc1.bldis)) + (SSet.union cc2.set (BlDis.term_set cc2.bldis)) in + let cc1, cc2 = insert_set cc1 terms, insert_set cc2 terms in + equal_eq_classes cc1 cc2 + && equal_diseqs cc1 cc2 + && equal_bldis cc1 cc2 + in if M.tracing then M.trace "c2po-equal" "equal eq classes. %b\nx=\n%s\ny=\n%s" res (show_all cc1) (show_all cc2);res let equal_normal_form x y = - let res = match x, y with - | Some x, Some y -> - if exactly_equal x y then - true - else - let nf1, nf2 = get_normal_form x, get_normal_form y in - if M.tracing then M.trace "c2po-min-repr" "Normal form of x = %s; Normal form of y = %s" (show_conj nf1) (show_conj nf2); - T.props_equal nf1 nf2 - | None, None -> true - | _ -> false + let res = + if exactly_equal x y then + true + else + let nf1, nf2 = get_normal_form x, get_normal_form y in + if M.tracing then M.trace "c2po-min-repr" "Normal form of x = %s; Normal form of y = %s" (show_conj nf1) (show_conj nf2); + T.props_equal nf1 nf2 in if M.tracing then M.trace "c2po-equal" "equal min repr. %b\nx=\n%s\ny=\n%s" res (show_all x) (show_all y);res let equal a b = @@ -63,136 +47,117 @@ module D = struct let equal a b = Timing.wrap "c2po-equal" (equal a) b - let empty () = Some init_cc - + let bot() = failwith "not supported" + let is_bot x = false + let empty () = init_cc () let init () = empty () - - let bot () = None - let is_bot x = Option.is_none x let top () = empty () - let is_top = function None -> false - | Some cc -> - TUF.is_empty cc.uf && Disequalities.is_empty cc.diseq && BlDis.is_empty cc.bldis + let is_top cc = TUF.is_empty cc.uf && Disequalities.is_empty cc.diseq && BlDis.is_empty cc.bldis - let join a' b' join_cc_function = + let join_f a b join_cc_function = let res = - match a',b' with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if exactly_equal a b then - a' - else - (if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(join_cc_function a b) in - let cmap1, cmap2 = fst(Disequalities.comp_map a.uf), fst(Disequalities.comp_map b.uf) - in let cc = Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc in - let cc = Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2) - in reset_normal_form cc) + if exactly_equal a b then + a + else + (if M.tracing then M.tracel "c2po-join" "JOIN AUTOMATON. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" + (show_all a) (show_all b); + let cc = fst(join_cc_function a b) in + let cmap1, cmap2 = fst(Disequalities.comp_map a.uf), fst(Disequalities.comp_map b.uf) + in let cc = join_bldis a.bldis b.bldis a b cc cmap1 cmap2 in + let cc = join_neq a.diseq b.diseq a b cc cmap1 cmap2 + in reset_normal_form cc) in if M.tracing then M.tracel "c2po-join" "JOIN. JOIN: %s\n" (show_all res); res let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then - (if M.tracing then M.trace "c2po-join" "Join Automaton"; join a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join a b join_eq_no_automata) + (if M.tracing then M.trace "c2po-join" "Join Automaton"; join_f a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_f a b join_eq_no_automata) let join a b = Timing.wrap "join" (join a) b - let widen_automata a' b' = + let widen_automata a b = (* we calculate the join and then restrict to the term set of a' *) - match a',b' with - | None, b -> b - | a, None -> a - | Some a, Some b -> - match join (Some a) (Some b) with - | None -> None - | Some join_result -> - reset_normal_form @@ remove_terms (fun t -> not @@ SSet.mem t a.set) join_result - - let widen_eq_classes a' b' = - let res = - match a',b' with - | None, b -> b - | a, None -> a - | Some a, Some b -> - if exactly_equal a b then - a' - else - (if M.tracing then M.tracel "c2po-join" "WIDEN. FIRST ELEMENT: %s\nSECOND ELEMENT: %s\n" - (show_all (Some a)) (show_all (Some b)); - let cc = fst(widen_eq_no_automata a b) in - let cmap1, cmap2 = fst(Disequalities.comp_map a.uf), fst(Disequalities.comp_map b.uf) - in let cc = Option.bind cc (fun cc -> join_neq a.diseq b.diseq a b cc cmap1 cmap2) in - let cc = Option.map (fun cc -> join_bldis a.bldis b.bldis a b cc cmap1 cmap2) cc in - reset_normal_form cc) - in - if M.tracing then M.tracel "c2po-join" "WIDEN. WIDEN: %s\n" - (show_all res); - res + let join_result = join a b in + reset_normal_form @@ remove_terms (fun t -> not @@ SSet.mem t a.set) join_result + + let widen_eq_classes a b = join_f a b widen_eq_no_automata let widen a b = if M.tracing then M.trace "c2po-widen" "WIDEN\n"; if GobConfig.get_bool "ana.c2po.precise_join" then widen_automata a b else widen_eq_classes a b - let meet a' b' = - if M.tracing then M.trace "c2po-meet" "MEET x= %s; y=%s" (show a') (show b'); - let res = match a',b' with - | None, _ -> None - | _, None -> None - | Some a, Some b -> - if exactly_equal a b then - a' - else - match get_conjunction a with - | [] -> b' - | a_conj -> reset_normal_form (meet_conjs_opt a_conj b') + let meet a b = + if M.tracing then M.trace "c2po-meet" "MEET x= %s; y=%s" (show a) (show b); + let res = + if exactly_equal a b then + a + else + match get_conjunction a with + | [] -> b + | a_conj -> reset_normal_form (meet_conjs_opt a_conj b) in if M.tracing then M.trace "c2po-meet" "MEET RESULT = %s" (show res); res - let leq x y = equal (meet x y) x - - let narrow a' b' = - let res = match a',b' with - | None, _ -> None - | _, None -> None - | Some a, Some b -> - if exactly_equal a b then - a' - else - let b_conj = List.filter - (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_conjunction b) in - reset_normal_form (meet_conjs_opt b_conj (Some a)) + let narrow a b = + let res = + if exactly_equal a b then + a + else + let b_conj = List.filter + (function | Equal (t1,t2,_)| Nequal (t1,t2,_)| BlNequal (t1,t2) -> SSet.mem t1 a.set && SSet.mem t2 a.set) (get_conjunction b) in + reset_normal_form (meet_conjs_opt b_conj a) in if M.tracing then M.trace "c2po-meet" "NARROW RESULT = %s" (show res);res - let pretty_diff () (x,y) = Pretty.dprintf "" + let leq x y = match equal (meet x y) x with + | exception Unsat -> false + | x -> x + + let pretty_diff () (x,y) = Pretty.dprintf "" (* TODO *) + +end + + +module D = struct + include Lattice.LiftBot (C2PODomain) + + let show_all = function + | `Bot -> show `Bot + | `Lifted x -> show_all x + + let meet a b = match meet a b with + | exception Unsat -> `Bot + | x -> x + + let narrow a b = match narrow a b with + | exception Unsat -> `Bot + | x -> x let printXml f x = match x with - | Some x -> + | `Lifted x -> BatPrintf.fprintf f "\n\n\nnormal form\n\n\n%s\n\nuf\n\n\n%s\n\nsubterm set\n\n\n%s\n\nmap\n\n\n%s\n\nmin. repr\n\n\n%s\n\ndiseq\n\n\n%s\n\n\n" - (XmlUtil.escape (Format.asprintf "%s" (show (Some x)))) + (XmlUtil.escape (Format.asprintf "%s" (show (`Lifted x)))) (XmlUtil.escape (Format.asprintf "%s" (TUF.show_uf x.uf))) (XmlUtil.escape (Format.asprintf "%s" (SSet.show_set x.set))) (XmlUtil.escape (Format.asprintf "%s" (LMap.show_map x.map))) (XmlUtil.escape (Format.asprintf "%s" (show_normal_form x.normal_form))) (XmlUtil.escape (Format.asprintf "%s" (Disequalities.show_neq x.diseq))) - | None -> BatPrintf.fprintf f "\nbottom\n\n" + | `Bot -> BatPrintf.fprintf f "\nbottom\n\n" (** Remove terms from the data structure. It removes all terms for which "var" is a subterm, while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variable var cc = if M.tracing then M.trace "c2po" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - Option.bind cc (remove_terms (fun t -> Var.equal (T.get_var t) var)) + remove_terms (fun t -> Var.equal (T.get_var t) var) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", while maintaining all equalities about variables that are not being removed.*) let remove_terms_containing_variables vars cc = if M.tracing then M.trace "c2po" "remove_terms_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^Var.show v) "" vars); - Option.bind cc (remove_terms (T.contains_variable vars)) + remove_terms (T.contains_variable vars) cc (** Remove terms from the data structure. It removes all terms which do not contain one of the "vars", @@ -200,25 +165,25 @@ module D = struct while maintaining all equalities about variables that are not being removed.*) let remove_terms_not_containing_variables vars cc = if M.tracing then M.trace "c2po" "remove_terms_not_containing_variables: %s\n" (List.fold_left (fun s v -> s ^"; " ^Var.show v) "" vars); - Option.bind cc (remove_terms (fun t -> (not (Var.to_varinfo (T.get_var t)).vglob) && not (T.contains_variable vars t))) + remove_terms (fun t -> (not (Var.to_varinfo (T.get_var t)).vglob) && not (T.contains_variable vars t)) cc (** Remove terms from the data structure. It removes all terms that may be changed after an assignment to "term".*) let remove_may_equal_terms ask s term cc = if M.tracing then M.trace "c2po" "remove_may_equal_terms: %s\n" (T.show term); let cc = snd (insert cc term) in - Option.bind cc (remove_terms (MayBeEqual.may_be_equal ask cc s term)) + remove_terms (MayBeEqual.may_be_equal ask cc s term) cc (** Remove terms from the data structure. It removes all terms that may point to one of the tainted addresses.*) let remove_tainted_terms ask address cc = if M.tracing then M.tracel "c2po-tainted" "remove_tainted_terms: %a\n" MayBeEqual.AD.pretty address; - Option.bind cc (fun cc -> remove_terms (MayBeEqual.may_point_to_one_of_these_addresses ask address cc) cc) + remove_terms (MayBeEqual.may_point_to_one_of_these_addresses ask address cc) cc (** Remove terms from the data structure. It removes all terms that are not in the scope, and also those that are tmp variables.*) let remove_vars_not_in_scope scope cc = - Option.bind cc (fun cc -> remove_terms (fun t -> + remove_terms (fun t -> let var = T.get_var t in - InvariantCil.var_is_tmp (Var.to_varinfo var) || not (InvariantCil.var_is_in_scope scope (Var.to_varinfo var))) cc) + InvariantCil.var_is_tmp (Var.to_varinfo var) || not (InvariantCil.var_is_in_scope scope (Var.to_varinfo var))) cc end diff --git a/src/cdomains/congruenceClosure.ml b/src/cdomains/congruenceClosure.ml index 0275e5bd94..a81b658e02 100644 --- a/src/cdomains/congruenceClosure.ml +++ b/src/cdomains/congruenceClosure.ml @@ -642,15 +642,12 @@ let get_conjunction cc = (** Sets the normal_form to an uncomputed value, that will be lazily computed when it is needed. *) let reset_normal_form cc = - match cc with - | None -> None - | Some cc -> - Some {cc with normal_form = lazy( - let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in - if M.tracing then M.trace "c2po-min-repr" "COMPUTE MIN REPR: %s" (MRMap.show_min_rep min_repr); - let conj = get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) - in if M.tracing then M.trace "c2po-equal" "COMPUTE NORMAL FORM: %s" (show_conj conj); conj - )} + {cc with normal_form = lazy( + let min_repr = MRMap.compute_minimal_representatives (cc.uf, cc.set, cc.map) in + if M.tracing then M.trace "c2po-min-repr" "COMPUTE MIN REPR: %s" (MRMap.show_min_rep min_repr); + let conj = get_normal_conjunction cc (fun t -> match MRMap.find_opt t min_repr with | None -> t,Z.zero | Some minr -> minr) + in if M.tracing then M.trace "c2po-equal" "COMPUTE NORMAL FORM: %s" (show_conj conj); conj + )} let show_all x = "Normal form:\n" ^ show_conj((get_conjunction x)) ^ @@ -679,28 +676,22 @@ let split conj = List.fold_left (fun (pos,neg,bld) -> function Returns \{uf, set, map, normal_form, bldis, diseq\}, where all data structures are initialized with an empty map/set. *) -let init_cc = +let init_cc () = {uf = TUF.empty; set = SSet.empty; map = LMap.empty; normal_form = lazy([]); diseq = Disequalities.empty; bldis = BlDis.empty} (** Computes the closure of disequalities. *) let congruence_neq cc neg = - try - let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in - (* getting args of dereferences *) - let uf,cmap,arg = Disequalities.get_args cc.uf in - (* taking implicit dis-equalities into account *) - let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap, arg) in - let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) cc.bldis neq_list in - (* taking explicit dis-equalities into account *) - let uf,neq_list = Disequalities.init_list_neq uf neg in - let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) cc.bldis neq_list in - if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); - Some {uf; set=cc.set; map=cc.map; normal_form=cc.normal_form;diseq=neq; bldis=cc.bldis} - with Unsat -> None - -let congruence_neq_opt cc neq = match cc with - | None -> None - | Some cc -> congruence_neq cc neq + let neg = Tuple3.second (split(Disequalities.get_disequalities cc.diseq)) @ neg in + (* getting args of dereferences *) + let uf,cmap,arg = Disequalities.get_args cc.uf in + (* taking implicit dis-equalities into account *) + let neq_list = Disequalities.init_neq (uf,cmap,arg) @ Disequalities.init_neg_block_diseq (uf, cc.bldis, cmap, arg) in + let neq = Disequalities.propagate_neq (uf,cmap,arg,Disequalities.empty) cc.bldis neq_list in + (* taking explicit dis-equalities into account *) + let uf,neq_list = Disequalities.init_list_neq uf neg in + let neq = Disequalities.propagate_neq (uf,cmap,arg,neq) cc.bldis neq_list in + if M.tracing then M.trace "c2po-neq" "congruence_neq: %s\nUnion find: %s\n" (Disequalities.show_neq neq) (TUF.show_uf uf); + {uf; set=cc.set; map=cc.map; normal_form=cc.normal_form;diseq=neq; bldis=cc.bldis} (** parameters: (uf, map, new_repr) equalities. @@ -792,12 +783,9 @@ let update_bldis new_repr bldis = They need to be updated with `congruence_neq`. *) let closure cc conjs = - match cc with - | None -> None - | Some cc -> - let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in - let bldis = update_bldis new_repr cc.bldis in - Some {uf; set = cc.set; map; normal_form=cc.normal_form; diseq=cc.diseq; bldis=bldis} + let (uf, map, new_repr) = closure (cc.uf, cc.map, TMap.empty) conjs in + let bldis = update_bldis new_repr cc.bldis in + {uf; set = cc.set; map; normal_form=cc.normal_form; diseq=cc.diseq; bldis=bldis} (** Adds the block disequalities to the cc, but first rewrites them such that they are disequalities between representatives. The cc should already contain @@ -806,14 +794,11 @@ let closure cc conjs = let rec add_normalized_bl_diseqs cc = function | [] -> cc | (t1,t2)::bl_conjs -> - match cc with - | None -> None - | Some cc -> - let t1',_,uf = TUF.find cc.uf t1 in - let t2',_,uf = TUF.find uf t2 in - if T.equal t1' t2' then None (*unsatisfiable*) - else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in - add_normalized_bl_diseqs (Some {cc with bldis;uf}) bl_conjs + let t1',_,uf = TUF.find cc.uf t1 in + let t2',_,uf = TUF.find uf t2 in + if T.equal t1' t2' then raise Unsat (*unsatisfiable*) + else let bldis = BlDis.add_block_diseq cc.bldis (t1',t2') in + add_normalized_bl_diseqs {cc with bldis;uf} bl_conjs (** Add a term to the data structure. @@ -821,33 +806,23 @@ let rec add_normalized_bl_diseqs cc = function let rec insert cc t = if SSet.mem t cc.set then let v,z,uf = TUF.find cc.uf t in - (v,z), Some {cc with uf} + (v,z), {cc with uf} else match t with | Addr _ | Aux _ -> let uf = TUF.ValMap.add t ((t, Z.zero),1) cc.uf in let set = SSet.add t cc.set in - (t, Z.zero), Some {cc with uf; set} + (t, Z.zero), {cc with uf; set} | Deref (t', z, exp) -> match insert cc t' with - | (v, r), None -> (v, r), None - | (v, r), Some cc -> + | (v, r), cc -> let set = SSet.add t cc.set in match LMap.map_find_opt (v, Z.(r + z)) cc.map with | Some v' -> let v2,z2,uf = TUF.find cc.uf v' in let uf = LMap.add t ((t, Z.zero),1) uf in - (v2,z2), closure (Some {cc with uf; set}) [(t, v', Z.zero)] + (v2,z2), closure {cc with uf; set} [(t, v', Z.zero)] | None -> let map = LMap.map_add (v, Z.(r + z)) t cc.map in let uf = LMap.add t ((t, Z.zero),1) cc.uf in - (t, Z.zero), Some {cc with uf; set; map} - -(** Add a term to the data structure. - - Returns (reference variable, offset), updated congruence closure *) -let insert cc t = - match cc with - | None -> (t, Z.zero), None - | Some cc -> let (r, z), cc = insert cc t in - (r, z), cc + (t, Z.zero), {cc with uf; set; map} (** Add all terms in a specific set to the data structure. @@ -875,9 +850,7 @@ let rec eq_query cc (t1,t2,r) = let block_neq_query cc (t1,t2) = let (v1,r1),cc = insert cc t1 in let (v2,r2),cc = insert cc t2 in - match cc with - | None -> true - | Some cc -> BlDis.map_set_mem v1 v2 cc.bldis + BlDis.map_set_mem v1 v2 cc.bldis (** Returns true if t1 and t2 are not equivalent. *) let neq_query cc (t1,t2,r) = @@ -890,12 +863,10 @@ let neq_query cc (t1,t2,r) = if Z.(equal r1 (r2 + r)) then false else true else - match cc with - | None -> true - | Some cc -> (* implicit disequalities following from block disequalities *) - BlDis.map_set_mem v1 v2 cc.bldis || - (*explicit dsequalities*) - Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq + (* implicit disequalities following from block disequalities *) + BlDis.map_set_mem v1 v2 cc.bldis || + (*explicit dsequalities*) + Disequalities.map_set_mem (v2,Z.(r2-r1+r)) v1 cc.diseq (** Adds equalities to the data structure. Throws "Unsat" if a contradiction is found. @@ -903,17 +874,15 @@ let neq_query cc (t1,t2,r) = let meet_pos_conjs cc pos_conjs = let res = let cc = insert_set cc (fst (SSet.subterms_of_conj pos_conjs)) in closure cc pos_conjs - in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (Option.map_default (fun res -> show_conj (get_conjunction res)) "None" res);res + in if M.tracing then M.trace "c2po-meet" "MEET_CONJS RESULT: %s\n" (show_conj (get_conjunction res)); res (** Adds propositions to the data structure. Returns None if a contradiction is found. *) let meet_conjs_opt conjs cc = let pos_conjs, neg_conjs, bl_conjs = split conjs in let terms_to_add = (fst (SSet.subterms_of_conj (neg_conjs @ List.map(fun (t1,t2)->(t1,t2,Z.zero)) bl_conjs))) in - match add_normalized_bl_diseqs (insert_set (meet_pos_conjs cc pos_conjs) terms_to_add) bl_conjs with - | exception Unsat -> None - | Some cc -> congruence_neq cc neg_conjs - | None -> None + let cc = add_normalized_bl_diseqs (insert_set (meet_pos_conjs cc pos_conjs) terms_to_add) bl_conjs in + congruence_neq cc neg_conjs (** Add proposition t1 = t2 + r to the data structure. Does not update the disequalities. *) @@ -926,11 +895,8 @@ let add_eq cc (t1, t2, r) = (** Adds block disequalities to cc: for each representative t in cc it adds the disequality bl(lterm) != bl(t)*) let add_block_diseqs cc lterm = - match cc with - | None -> cc - | Some cc -> - let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in - Some {cc with bldis} + let bldis = BlDis.add_block_diseqs cc.bldis cc.uf lterm (TUF.get_representatives cc.uf) in + {cc with bldis} (* Remove variables: *) @@ -955,7 +921,7 @@ let remove_terms_from_eq predicate cc = (uf, new_reps, new_cc, (old_rep, new_rep, Z.(old_z - new_z))::reachable_old_reps) in let uf, new_reps, new_cc, reachable_old_reps = - SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (cc.uf, TMap.empty, (Some init_cc),[]) cc.set in + SSet.fold_atoms (fun acc x -> if (not (predicate x)) then add_atom acc x else acc) (cc.uf, TMap.empty, init_cc (),[]) cc.set in let cmap,uf = Disequalities.comp_map uf in (* breadth-first search of reachable states *) let add_transition (old_rep, new_rep, z1) (uf, new_reps, new_cc, reachable_old_reps) (s_z,s_t) = @@ -1044,12 +1010,10 @@ let remove_terms_from_bldis bldis new_reps cc = while maintaining all equalities about variables that are not being removed.*) let remove_terms predicate cc = let old_cc = cc in - match remove_terms_from_eq predicate cc with - | new_reps, Some cc -> - let uf,bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in - let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with uf;bldis} in - cc - | _,None -> None + let new_reps, cc = remove_terms_from_eq predicate cc in + let uf,bldis = remove_terms_from_bldis old_cc.bldis new_reps cc in + let cc = remove_terms_from_diseq old_cc.diseq new_reps {cc with uf;bldis} in + cc let remove_terms p cc = Timing.wrap "removing terms" (remove_terms p) cc @@ -1071,7 +1035,7 @@ let join_eq cc1 cc2 = | None -> Map.add new_element (new_term, a_off) pmap, cc, new_element::new_pairs | Some (c, c1_off) -> pmap, add_eq cc (new_term, c, Z.(-c1_off + a_off)),new_pairs in - let pmap,cc,working_set = List.fold_left add_term (Map.empty, Some init_cc,[]) mappings in + let pmap,cc,working_set = List.fold_left add_term (Map.empty, init_cc (),[]) mappings in (* add equalities that make sure that all atoms that have the same representative are equal. *) let add_one_edge y t t1_off diff (pmap, cc, new_pairs) (offset, a) = @@ -1097,7 +1061,7 @@ let join_eq cc1 cc2 = (** Join version 2: just look at equivalence classes and not the automaton. *) let product_no_automata_over_terms cc1 cc2 terms = - let cc1, cc2 = Option.get (insert_set (Some cc1) terms), Option.get (insert_set (Some cc2) terms) in + let cc1, cc2 = insert_set cc1 terms, insert_set cc2 terms in let mappings = List.map (fun a -> let r1, off1 = TUF.find_no_pc cc1.uf a in let r2, off2 = TUF.find_no_pc cc2.uf a in @@ -1107,7 +1071,7 @@ let product_no_automata_over_terms cc1 cc2 terms = | None -> cc, Map.add new_element (new_term, a_off) pmap | Some (c, c1_off) -> add_eq cc (new_term, c, Z.(-c1_off + a_off)), pmap in - List.fold_left add_term (Some init_cc, Map.empty) mappings + List.fold_left add_term (init_cc(), Map.empty) mappings (** Here we do the join without using the automata. We construct a new cc that contains the elements of cc1.set U cc2.set. @@ -1129,11 +1093,11 @@ let join_neq diseq1 diseq2 cc1 cc2 cc cmap1 cmap2 = let _,diseq2,_ = split (Disequalities.get_disequalities diseq2) in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (neq_query (Some cc2)) (Disequalities.element_closure diseq1 cmap1 cc.uf) in - let diseq2 = List.filter (neq_query (Some cc1)) (Disequalities.element_closure diseq2 cmap2 cc.uf) in - let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2))) in + let diseq1 = List.filter (neq_query cc2) (Disequalities.element_closure diseq1 cmap1 cc.uf) in + let diseq2 = List.filter (neq_query cc1) (Disequalities.element_closure diseq2 cmap2 cc.uf) in + let cc = insert_set cc (fst @@ SSet.subterms_of_conj (diseq1 @ diseq2)) in let res = congruence_neq cc (diseq1 @ diseq2) - in (if M.tracing then match res with | Some r -> M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq r.diseq) | None -> ()); res + in (if M.tracing then M.trace "c2po-neq" "join_neq: %s\n\n" (Disequalities.show_neq res.diseq)); res (** Joins the block disequalities bldiseq1 and bldiseq2, given a congruence closure data structure. @@ -1143,9 +1107,9 @@ let join_bldis bldiseq1 bldiseq2 cc1 cc2 cc cmap1 cmap2 = let bldiseq2 = BlDis.to_conj bldiseq2 in (* keep all disequalities from diseq1 that are implied by cc2 and those from diseq2 that are implied by cc1 *) - let diseq1 = List.filter (block_neq_query (Some cc2)) (BlDis.element_closure bldiseq1 cmap1) in - let diseq2 = List.filter (block_neq_query (Some cc1)) (BlDis.element_closure bldiseq2 cmap2) in - let cc = Option.get (insert_set (Some cc) (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2)))) in + let diseq1 = List.filter (block_neq_query cc2) (BlDis.element_closure bldiseq1 cmap1) in + let diseq2 = List.filter (block_neq_query cc1) (BlDis.element_closure bldiseq2 cmap2) in + let cc = insert_set cc (fst @@ SSet.subterms_of_conj (List.map (fun (a,b) -> (a,b,Z.zero)) (diseq1 @ diseq2))) in let diseqs_ref_terms = List.filter (fun (t1,t2) -> TUF.is_root cc.uf t1 && TUF.is_root cc.uf t2) (diseq1 @ diseq2) in let bldis = List.fold BlDis.add_block_diseq BlDis.empty diseqs_ref_terms in (if M.tracing then M.trace "c2po-neq" "join_bldis: %s\n\n" (show_conj (BlDis.to_conj bldis))); @@ -1285,7 +1249,7 @@ module MayBeEqual = struct (if T.equal q' q && there_is_an_overlap s s' diff then true else (* If we have a disequality, then they are not equal *) - if neq_query (Some cc) (t,v,Z.(z'-z)) then false else + if neq_query cc (t,v,Z.(z'-z)) then false else (* or if we know that they are not equal according to the query MayPointTo*) if GobConfig.get_bool "ana.c2po.askbase" then (may_point_to_same_address ask t v Z.(z' - z) cc) else true) @@ -1296,12 +1260,9 @@ module MayBeEqual = struct (**Returns true iff by assigning to t1, the value of t2 could change. The parameter s is the size in bits of the variable t1 we are assigning to. *) let may_be_equal ask cc s t1 t2 = - match cc with - | None -> false - | Some cc -> - let res = (may_be_equal ask cc s t1 t2) in - if M.tracing then M.tracel "c2po-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; - res + let res = (may_be_equal ask cc s t1 t2) in + if M.tracing then M.tracel "c2po-maypointto" "MAY BE EQUAL: %s %s: %b\n" (T.show t1) (T.show t2) res; + res (**Returns true if `t2` or any subterm of `t2` may possibly point to one of the addresses in `addresses`.*) let rec may_point_to_one_of_these_addresses ask addresses cc t2 = From 03fca721661851f0fc5d9159d999faa8743e28fc Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 11:25:18 +0200 Subject: [PATCH 316/323] catch exception --- src/cdomains/unionFind.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index 6b7c6d14f8..d5674c3c2e 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -213,7 +213,7 @@ module T = struct match IntDomain.IntDomTuple.to_int @@ cil_offs_to_idx ask offs typ with | Some i -> i | None - | exception (SizeOfError _) -> if M.tracing then M.trace "c2po-invalidate" "REASON: unknown offset"; + | exception (SizeOfError _)| exception (Cilfacade.TypeOfError _) -> if M.tracing then M.trace "c2po-invalidate" "REASON: unknown offset"; raise (UnsupportedCilExpression "unknown offset") let can_be_dereferenced t = From 07ab99ab63b7af3ead89e5e6ca46298432888c62 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 11:37:08 +0200 Subject: [PATCH 317/323] implemented pretty_diff --- src/cdomains/c2poDomain.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 6df58f5329..dbd363bd81 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -114,7 +114,12 @@ module C2PODomain = struct | exception Unsat -> false | x -> x - let pretty_diff () (x,y) = Pretty.dprintf "" (* TODO *) + let pretty_diff () (x,y) = + let x_conj = get_conjunction x in + let y_conj = get_conjunction y in + let x_diff = List.filter (fun a -> not (List.mem_cmp compare_prop a y_conj)) x_conj in + let y_diff = List.filter (fun a -> not (List.mem_cmp compare_prop a x_conj)) y_conj in + Pretty.dprintf ("Additional propositions of first element:\n%s\nAdditional propositions of second element:\n%s\n") (show_conj x_diff) (show_conj y_diff) end From e22a98957f07a485328c1d3e72c96879e9d7996f Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 11:46:40 +0200 Subject: [PATCH 318/323] remove debug print --- src/cdomains/unionFind.ml | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/cdomains/unionFind.ml b/src/cdomains/unionFind.ml index d5674c3c2e..52f83e543c 100644 --- a/src/cdomains/unionFind.ml +++ b/src/cdomains/unionFind.ml @@ -100,9 +100,6 @@ module T = struct | Nequal (t1,t2,r) -> show t1 ^ " != " ^ Z.to_string r ^ "+" ^ show t2 | BlNequal (t1,t2) -> "bl(" ^ show t1 ^ ") != bl(" ^ show t2 ^ ")" - let equal_v_prop a b = let res = equal_v_prop a b in - print_string ((show_prop a)^"; "^(show_prop b)^"; "^string_of_bool res ^"\n"); res - (** Returns true if the first parameter is a subterm of the second one. *) let rec is_subterm st term = equal st term || match term with | Deref (t, _, _) -> is_subterm st t From addbbd4a1e77faa3c55b010a239d78ba61341cff Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 12:35:40 +0200 Subject: [PATCH 319/323] make precise_join an enum --- src/cdomains/c2poDomain.ml | 12 +- src/config/options.schema.json | 730 +++++++++++------- .../regression/83-c2po/18-complicated-join.c | 2 +- 3 files changed, 440 insertions(+), 304 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index dbd363bd81..d96b4dcf61 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -71,8 +71,9 @@ module C2PODomain = struct (show_all res); res - let join a b = if GobConfig.get_bool "ana.c2po.precise_join" then - (if M.tracing then M.trace "c2po-join" "Join Automaton"; join_f a b join_eq) else (if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_f a b join_eq_no_automata) + let join a b = match GobConfig.get_string "ana.c2po.join_algorithm" with + | "precise" -> if M.tracing then M.trace "c2po-join" "Join Automaton"; join_f a b join_eq + | _ -> if M.tracing then M.trace "c2po-join" "Join Eq classes"; join_f a b join_eq_no_automata let join a b = Timing.wrap "join" (join a) b @@ -84,9 +85,10 @@ module C2PODomain = struct let widen_eq_classes a b = join_f a b widen_eq_no_automata let widen a b = if M.tracing then M.trace "c2po-widen" "WIDEN\n"; - if GobConfig.get_bool "ana.c2po.precise_join" then - widen_automata a b - else widen_eq_classes a b + match GobConfig.get_string "ana.c2po.join_algorithm" with + | "precise" -> widen_automata a b + | _ -> widen_eq_classes a b + let meet a b = if M.tracing then M.trace "c2po-meet" "MEET x= %s; y=%s" (show a) (show b); diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 8a4f098b93..37f09eb3a1 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -31,8 +31,7 @@ }, "verify": { "title": "verify", - "description": - "Verify that the solver reached a post-fixpoint. Beware that disabling this also disables output of warnings since post-processing of the results is done in the verification phase!", + "description": "Verify that the solver reached a post-fixpoint. Beware that disabling this also disables output of warnings since post-processing of the results is done in the verification phase!", "type": "boolean", "default": true }, @@ -40,27 +39,34 @@ "title": "mainfun", "description": "Sets the name of the main functions.", "type": "array", - "items": { "type": "string" }, - "default": [ "main" ] + "items": { + "type": "string" + }, + "default": [ + "main" + ] }, "exitfun": { "title": "exitfun", "description": "Sets the name of the cleanup functions.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "otherfun": { "title": "otherfun", "description": "Sets the name of other functions.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "allglobs": { "title": "allglobs", - "description": - "Prints access information about all globals, not just races.", + "description": "Prints access information about all globals, not just races.", "type": "boolean", "default": false }, @@ -78,10 +84,16 @@ }, "result": { "title": "result", - "description": - "Result style: none, fast_xml, json, pretty, json-messages, sarif.", + "description": "Result style: none, fast_xml, json, pretty, json-messages, sarif.", "type": "string", - "enum": ["none", "fast_xml", "json", "pretty", "json-messages", "sarif"], + "enum": [ + "none", + "fast_xml", + "json", + "pretty", + "json-messages", + "sarif" + ], "default": "none" }, "solver": { @@ -98,8 +110,7 @@ }, "allfuns": { "title": "allfuns", - "description": - "Analyzes all the functions (not just beginning from main). This requires exp.earlyglobs!", + "description": "Analyzes all the functions (not just beginning from main). This requires exp.earlyglobs!", "type": "boolean", "default": false }, @@ -111,10 +122,13 @@ }, "colors": { "title": "colors", - "description": - "Colored output (via ANSI escape codes). 'auto': enabled if stdout is a terminal (instead of a pipe); 'always', 'never'.", + "description": "Colored output (via ANSI escape codes). 'auto': enabled if stdout is a terminal (instead of a pipe); 'always', 'never'.", "type": "string", - "enum": ["auto", "always", "never"], + "enum": [ + "auto", + "always", + "never" + ], "default": "auto" }, "g2html": { @@ -125,8 +139,7 @@ }, "save_run": { "title": "save_run", - "description": - "Save the result of the solver, the current configuration and meta-data about the run to this directory (if set). The data can then be loaded (without solving again) to do post-processing like generating output in a different format or comparing results.", + "description": "Save the result of the solver, the current configuration and meta-data about the run to this directory (if set). The data can then be loaded (without solving again) to do post-processing like generating output in a different format or comparing results.", "type": "string", "default": "" }, @@ -138,24 +151,27 @@ }, "compare_runs": { "title": "compare_runs", - "description": - "Load these saved runs and compare the results. Note that currently only two runs can be compared!", + "description": "Load these saved runs and compare the results. Note that currently only two runs can be compared!", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "warn_at": { "title": "warn_at", - "description": - "When to output warnings. Values: 'post' (default): after solving; 'never': no warnings; 'early': for debugging - outputs warnings already while solving (may lead to spurious warnings/asserts that would disappear after narrowing).", + "description": "When to output warnings. Values: 'post' (default): after solving; 'never': no warnings; 'early': for debugging - outputs warnings already while solving (may lead to spurious warnings/asserts that would disappear after narrowing).", "type": "string", - "enum": ["post", "never", "early"], + "enum": [ + "post", + "never", + "early" + ], "default": "post" }, "gobview": { "title": "gobview", - "description": - "Include additional information for GobView (e.g., the Goblint warning messages) in the directory specified by 'save_run'.", + "description": "Include additional information for GobView (e.g., the Goblint warning messages) in the directory specified by 'save_run'.", "type": "boolean", "default": false }, @@ -184,8 +200,7 @@ }, "keep": { "title": "pre.keep", - "description": - "Keep the intermediate output of running the C preprocessor.", + "description": "Keep the intermediate output of running the C preprocessor.", "type": "boolean", "default": false }, @@ -199,21 +214,27 @@ "title": "pre.includes", "description": "List of directories to include.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "kernel_includes": { "title": "pre.kernel_includes", "description": "List of kernel directories to include.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "custom_includes": { "title": "pre.custom_includes", "description": "List of custom directories to include.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "kernel-root": { @@ -226,7 +247,9 @@ "title": "pre.cppflags", "description": "Pre-processing parameters.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "compdb": { @@ -235,8 +258,7 @@ "properties": { "original-path": { "title": "pre.compdb.original-path", - "description": - "Original absolute path of Compilation Database. Used to reroot all absolute paths in there if moved, e.g. in container mounts.", + "description": "Original absolute path of Compilation Database. Used to reroot all absolute paths in there if moved, e.g. in container mounts.", "type": "string", "default": "" }, @@ -281,7 +303,11 @@ "type": "string", "description": "Specify the c standard used for parsing.", "default": "c99", - "enum": ["c90", "c99", "c11"] + "enum": [ + "c90", + "c99", + "c11" + ] }, "gnu89inline": { "title": "cil.gnu89inline", @@ -313,7 +339,10 @@ "title": "server.mode", "description": "Server transport mode", "type": "string", - "enum": ["stdio", "unix"], + "enum": [ + "stdio", + "unix" + ], "default": "stdio" }, "unix-socket": { @@ -340,35 +369,64 @@ "title": "ana.activated", "description": "Lists of activated analyses.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [ - "expRelation", "base", "threadid", "threadflag", "threadreturn", - "escape", "mutexEvents", "mutex", "access", "race", "mallocWrapper", "mhp", - "assert", "pthreadMutexType" + "expRelation", + "base", + "threadid", + "threadflag", + "threadreturn", + "escape", + "mutexEvents", + "mutex", + "access", + "race", + "mallocWrapper", + "mhp", + "assert", + "pthreadMutexType" ] }, "path_sens": { "title": "ana.path_sens", "description": "List of path-sensitive analyses", "type": "array", - "items": { "type": "string" }, - "default": [ "mutex", "malloc_null", "uninit", "expsplit","activeSetjmp","memLeak" ] + "items": { + "type": "string" + }, + "default": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak" + ] }, "ctx_insens": { "title": "ana.ctx_insens", "description": "List of context-insensitive analyses. This setting is ignored if `ana.ctx_sens` contains elements.", "type": "array", - "items": { "type": "string" }, - "default": [ "stack_loc", "stack_trace_set" ] + "items": { + "type": "string" + }, + "default": [ + "stack_loc", + "stack_trace_set" + ] }, "ctx_sens": { "title": "ana.ctx_sens", "description": "List of context-sensitive analyses. In case this list is empty, `ana.ctx_insens` will be used to determine the set of context-insensitive analyses.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, - "setjmp" : { + "setjmp": { "title": "ana.setjmp", "description": "Setjmp/Longjmp analysis", "type": "object", @@ -377,7 +435,11 @@ "title": "ana.setjmp.split", "description": "Split returns of setjmp", "type": "string", - "enum": ["none", "coarse", "precise"], + "enum": [ + "none", + "coarse", + "precise" + ], "default": "precise" } }, @@ -389,15 +451,13 @@ "properties": { "def_exc": { "title": "ana.int.def_exc", - "description": - "Use IntDomain.DefExc: definite value/exclusion set.", + "description": "Use IntDomain.DefExc: definite value/exclusion set.", "type": "boolean", "default": true }, "interval": { "title": "ana.int.interval", - "description": - "Use IntDomain.Interval32: (Z.t * Z.t) option.", + "description": "Use IntDomain.Interval32: (Z.t * Z.t) option.", "type": "boolean", "default": false }, @@ -409,30 +469,30 @@ }, "enums": { "title": "ana.int.enums", - "description": - "Use IntDomain.Enums: Inclusion/Exclusion sets. Go to top on arithmetic operations (except for some easy cases, e.g. multiplication with 0). Joins on widen, i.e. precise integers as long as not derived from arithmetic expressions.", + "description": "Use IntDomain.Enums: Inclusion/Exclusion sets. Go to top on arithmetic operations (except for some easy cases, e.g. multiplication with 0). Joins on widen, i.e. precise integers as long as not derived from arithmetic expressions.", "type": "boolean", "default": false }, "congruence": { "title": "ana.int.congruence", - "description": - "Use IntDomain.Congruence: (c, m) option, meaning congruent to c modulo m", + "description": "Use IntDomain.Congruence: (c, m) option, meaning congruent to c modulo m", "type": "boolean", "default": false }, "refinement": { "title": "ana.int.refinement", - "description": - "Use mutual refinement of integer domains. Either 'never', 'once' or 'fixpoint'. Counterintuitively, may reduce precision unless ana.int.interval_narrow_by_meet is also enabled.", + "description": "Use mutual refinement of integer domains. Either 'never', 'once' or 'fixpoint'. Counterintuitively, may reduce precision unless ana.int.interval_narrow_by_meet is also enabled.", "type": "string", - "enum": ["never", "once", "fixpoint"], + "enum": [ + "never", + "once", + "fixpoint" + ], "default": "never" }, "def_exc_widen_by_join": { "title": "ana.int.def_exc_widen_by_join", - "description": - "Perform def_exc widening by joins. Gives threshold-widening like behavior, with thresholds given by the ranges of different integer types.", + "description": "Perform def_exc widening by joins. Gives threshold-widening like behavior, with thresholds given by the ranges of different integer types.", "type": "boolean", "default": false }, @@ -444,17 +504,18 @@ }, "interval_threshold_widening": { "title": "ana.int.interval_threshold_widening", - "description": - "Use constants appearing in program as threshold for widening", + "description": "Use constants appearing in program as threshold for widening", "type": "boolean", "default": false }, "interval_threshold_widening_constants": { "title": "ana.int.interval_threshold_widening_constants", - "description": - "Which constants in the program should be considered as threshold constants (all/comparisons)", + "description": "Which constants in the program should be considered as threshold constants (all/comparisons)", "type": "string", - "enum": ["all", "comparisons"], + "enum": [ + "all", + "comparisons" + ], "default": "all" } }, @@ -466,15 +527,13 @@ "properties": { "interval": { "title": "ana.float.interval", - "description": - "Use FloatDomain: (float * float) option.", + "description": "Use FloatDomain: (float * float) option.", "type": "boolean", "default": false }, "evaluate_math_functions": { "title": "ana.float.evaluate_math_functions", - "description": - "Allow a more precise evaluation of some functions from math.h. Evaluation of functions may differ depending on the implementation of math.h. Caution: For some implementations of functions it is not guaranteed that they behave monotonic where they mathematically should, thus possibly leading to unsoundness.", + "description": "Allow a more precise evaluation of some functions from math.h. Evaluation of functions may differ depending on the implementation of math.h. Caution: For some implementations of functions it is not guaranteed that they behave monotonic where they mathematically should, thus possibly leading to unsoundness.", "type": "boolean", "default": false } @@ -487,8 +546,7 @@ "properties": { "debug": { "title": "ana.pml.debug", - "description": - "Insert extra assertions into Promela code for debugging.", + "description": "Insert extra assertions into Promela code for debugging.", "type": "boolean", "default": true } @@ -501,15 +559,13 @@ "properties": { "hashcons": { "title": "ana.opt.hashcons", - "description": - "Should we try to save memory and speed up equality by hashconsing?", + "description": "Should we try to save memory and speed up equality by hashconsing?", "type": "boolean", "default": true }, "equal": { "title": "ana.opt.equal", - "description": - "First try physical equality (==) before {D,G,C}.equal (only done if hashcons is disabled since it basically does the same via its tags).", + "description": "First try physical equality (==) before {D,G,C}.equal (only done if hashcons is disabled since it basically does the same via its tags).", "type": "boolean", "default": true } @@ -595,8 +651,7 @@ }, "wp": { "title": "ana.wp", - "description": - "Weakest precondition feasibility analysis for SV-COMP violations", + "description": "Weakest precondition feasibility analysis for SV-COMP violations", "type": "boolean", "default": false }, @@ -628,15 +683,13 @@ }, "interval": { "title": "ana.base.context.interval", - "description": - "Integer values of the Interval domain in function contexts.", + "description": "Integer values of the Interval domain in function contexts.", "type": "boolean", "default": true }, "interval_set": { "title": "ana.base.context.interval_set", - "description": - "Integer values of the IntervalSet domain in function contexts.", + "description": "Integer values of the IntervalSet domain in function contexts.", "type": "boolean", "default": true } @@ -651,7 +704,11 @@ "title": "ana.base.strings.domain", "description": "Domain for string literals.", "type": "string", - "enum": ["unit", "flat", "disjoint"], + "enum": [ + "unit", + "flat", + "disjoint" + ], "default": "flat" } }, @@ -663,39 +720,42 @@ "properties": { "keep-expr": { "title": "ana.base.partition-arrays.keep-expr", - "description": - "When using the partitioning which expression should be used for partitioning ('first', 'last')", + "description": "When using the partitioning which expression should be used for partitioning ('first', 'last')", "type": "string", - "enum": ["first", "last"], + "enum": [ + "first", + "last" + ], "default": "first" }, "partition-by-const-on-return": { "title": "ana.base.partition-arrays.partition-by-const-on-return", - "description": - "When using the partitioning should arrays be considered partitioned according to a constant if a var in the expression used for partitioning goes out of scope?", + "description": "When using the partitioning should arrays be considered partitioned according to a constant if a var in the expression used for partitioning goes out of scope?", "type": "boolean", "default": false }, "smart-join": { "title": "ana.base.partition-arrays.smart-join", - "description": - "When using the partitioning should the join of two arrays partitioned according to different expressions be partitioned as well if possible? If keep-expr is 'last' this behavior is enabled regardless of the flag value. Caution: Not always advantageous.", + "description": "When using the partitioning should the join of two arrays partitioned according to different expressions be partitioned as well if possible? If keep-expr is 'last' this behavior is enabled regardless of the flag value. Caution: Not always advantageous.", "type": "boolean", "default": false } }, "additionalProperties": false }, - "arrays":{ + "arrays": { "title": "ana.base.arrays", "type": "object", "properties": { "domain": { "title": "ana.base.arrays.domain", - "description": - "The domain that should be used for arrays. When employing the partition array domain, make sure to enable the expRelation analysis as well. When employing the unrolling array domain, make sure to set the ana.base.arrays.unrolling-factor >0.", + "description": "The domain that should be used for arrays. When employing the partition array domain, make sure to enable the expRelation analysis as well. When employing the unrolling array domain, make sure to set the ana.base.arrays.unrolling-factor >0.", "type": "string", - "enum": ["trivial", "partitioned", "unroll"], + "enum": [ + "trivial", + "partitioned", + "unroll" + ], "default": "trivial" }, "unrolling-factor": { @@ -719,10 +779,15 @@ "properties": { "domain": { "title": "ana.base.structs.domain", - "description": - "The domain that should be used for structs. simple/sets/keyed/combined-all/combined-sk", + "description": "The domain that should be used for structs. simple/sets/keyed/combined-all/combined-sk", "type": "string", - "enum": ["simple", "sets", "keyed", "combined-all", "combined-sk"], + "enum": [ + "simple", + "sets", + "keyed", + "combined-all", + "combined-sk" + ], "default": "simple" }, "key": { @@ -731,22 +796,19 @@ "properties": { "forward": { "title": "ana.base.structs.key.forward", - "description": - "Whether the struct key should be picked going from first field to last.", + "description": "Whether the struct key should be picked going from first field to last.", "type": "boolean", "default": true }, "avoid-ints": { "title": "ana.base.structs.key.avoid-ints", - "description": - "Whether integers should be avoided for key.", + "description": "Whether integers should be avoided for key.", "type": "boolean", "default": true }, "prefer-ptrs": { "title": "ana.base.structs.key.prefer-ptrs", - "description": - "Whether pointers should be preferred for key.", + "description": "Whether pointers should be preferred for key.", "type": "boolean", "default": true } @@ -758,10 +820,30 @@ }, "privatization": { "title": "ana.base.privatization", - "description": - "Which privatization to use? none/mutex-oplus/mutex-meet/mutex-meet-tid/protection/protection-read/mine/mine-nothread/mine-W/mine-W-noinit/lock/lock-tid/write/write-tid/write+lock/write+lock-tid", + "description": "Which privatization to use? none/mutex-oplus/mutex-meet/mutex-meet-tid/protection/protection-read/mine/mine-nothread/mine-W/mine-W-noinit/lock/lock-tid/write/write-tid/write+lock/write+lock-tid", "type": "string", - "enum": ["none", "mutex-oplus", "mutex-meet", "protection", "protection-tid", "protection-atomic", "protection-read", "protection-read-tid", "protection-read-atomic", "mine", "mine-nothread", "mine-W", "mine-W-noinit", "lock", "lock-tid", "write", "write-tid", "write+lock", "write+lock-tid", "mutex-meet-tid"], + "enum": [ + "none", + "mutex-oplus", + "mutex-meet", + "protection", + "protection-tid", + "protection-atomic", + "protection-read", + "protection-read-tid", + "protection-read-atomic", + "mine", + "mine-nothread", + "mine-W", + "mine-W-noinit", + "lock", + "lock-tid", + "write", + "write-tid", + "write+lock", + "write+lock-tid", + "mutex-meet-tid" + ], "default": "protection-read" }, "priv": { @@ -770,15 +852,13 @@ "properties": { "not-started": { "title": "ana.base.priv.not-started", - "description": - "Exclude writes from threads that may not be started yet", + "description": "Exclude writes from threads that may not be started yet", "type": "boolean", "default": true }, "must-joined": { "title": "ana.base.priv.must-joined", - "description": - "Exclude writes from threads that must have been joined", + "description": "Exclude writes from threads that must have been joined", "type": "boolean", "default": true } @@ -805,7 +885,10 @@ "title": "ana.base.invariant.unassume", "description": "How many times to unassume an invariant: once or until fixpoint (at least twice as expensive).", "type": "string", - "enum": ["once", "fixpoint"], + "enum": [ + "once", + "fixpoint" + ], "default": "once" }, "int": { @@ -816,7 +899,11 @@ "title": "ana.base.invariant.int.simplify", "description": "How much to simplify int domain invariants. Value \"int\" only simplifies definite integers. Without int domain refinement \"all\" might not be maximally precise.", "type": "string", - "enum": ["none", "int", "all"], + "enum": [ + "none", + "int", + "all" + ], "default": "all" } }, @@ -847,20 +934,24 @@ "properties": { "wrappers": { "title": "ana.malloc.wrappers", - "description": - "Loads a list of known malloc wrapper functions.", + "description": "Loads a list of known malloc wrapper functions.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [ - "kmalloc", "__kmalloc", "usb_alloc_urb", "__builtin_alloca", + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", "kzalloc" ] }, "unique_address_count": { - "title": "ana.malloc.unique_address_count", - "description": "Number of unique memory addresses allocated for each malloc node.", - "type": "integer", - "default": 0 + "title": "ana.malloc.unique_address_count", + "description": "Number of unique memory addresses allocated for each malloc node.", + "type": "integer", + "default": 0 } }, "additionalProperties": false @@ -877,25 +968,30 @@ }, "domain": { "title": "ana.apron.domain", - "description": - "Which domain should be used for the Apron analysis. Can be 'octagon', 'interval' or 'polyhedra'", + "description": "Which domain should be used for the Apron analysis. Can be 'octagon', 'interval' or 'polyhedra'", "type": "string", - "enum": ["octagon", "interval", "polyhedra", "affeq"], + "enum": [ + "octagon", + "interval", + "polyhedra", + "affeq" + ], "default": "octagon" }, "threshold_widening": { "title": "ana.apron.threshold_widening", - "description": - "Use constants appearing in program as threshold for widening", + "description": "Use constants appearing in program as threshold for widening", "type": "boolean", "default": false }, "threshold_widening_constants": { "title": "ana.apron.threshold_widening_constants", - "description": - "Which constants in the programm should be considered as threshold constants", + "description": "Which constants in the programm should be considered as threshold constants", "type": "string", - "enum": ["all", "comparisons"], + "enum": [ + "all", + "comparisons" + ], "default": "all" }, "invariant": { @@ -926,10 +1022,21 @@ }, "privatization": { "title": "ana.relation.privatization", - "description": - "Which relation privatization to use? top/protection/protection-path/mutex-meet/mutex-meet-tid/mutex-meet-tid-cluster12/mutex-meet-tid-cluster2/mutex-meet-tid-cluster-max/mutex-meet-tid-cluster-power", + "description": "Which relation privatization to use? top/protection/protection-path/mutex-meet/mutex-meet-tid/mutex-meet-tid-cluster12/mutex-meet-tid-cluster2/mutex-meet-tid-cluster-max/mutex-meet-tid-cluster-power", "type": "string", - "enum": ["top", "protection", "protection-path", "mutex-meet", "mutex-meet-atomic", "mutex-meet-tid", "mutex-meet-tid-atomic", "mutex-meet-tid-cluster12", "mutex-meet-tid-cluster2", "mutex-meet-tid-cluster-max", "mutex-meet-tid-cluster-power"], + "enum": [ + "top", + "protection", + "protection-path", + "mutex-meet", + "mutex-meet-atomic", + "mutex-meet-tid", + "mutex-meet-tid-atomic", + "mutex-meet-tid-cluster12", + "mutex-meet-tid-cluster2", + "mutex-meet-tid-cluster-max", + "mutex-meet-tid-cluster-power" + ], "default": "mutex-meet" }, "priv": { @@ -938,15 +1045,13 @@ "properties": { "not-started": { "title": "ana.relation.priv.not-started", - "description": - "Exclude writes from threads that may not be started yet", + "description": "Exclude writes from threads that may not be started yet", "type": "boolean", "default": true }, "must-joined": { "title": "ana.relation.priv.must-joined", - "description": - "Exclude writes from threads that must have been joined", + "description": "Exclude writes from threads that must have been joined", "type": "boolean", "default": true } @@ -987,8 +1092,7 @@ "properties": { "widen": { "title": "ana.context.widen", - "description": - "Do widening on contexts. Keeps a map of function to call state; enter will then return the widened local state for recursive calls.", + "description": "Do widening on contexts. Keeps a map of function to call state; enter will then return the widened local state for recursive calls.", "type": "boolean", "default": false }, @@ -1013,25 +1117,27 @@ "properties": { "domain": { "title": "ana.thread.domain", - "description": - "Which domain should be used for the thread ids. Can be 'history' or 'plain'", + "description": "Which domain should be used for the thread ids. Can be 'history' or 'plain'", "type": "string", - "enum": ["history", "plain"], + "enum": [ + "history", + "plain" + ], "default": "history" }, - "include-node" : { + "include-node": { "title": "ana.thread.include-node", - "description": - "Whether the node at which a thread is created is part of its threadid", + "description": "Whether the node at which a thread is created is part of its threadid", "type": "boolean", - "default" : true + "default": true }, "wrappers": { "title": "ana.thread.wrappers", - "description": - "Loads a list of known thread spawn (pthread_create) wrapper functions.", + "description": "Loads a list of known thread spawn (pthread_create) wrapper functions.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "unique_thread_id_count": { @@ -1078,7 +1184,7 @@ "type": "boolean", "default": false }, - "volatile" :{ + "volatile": { "title": "ana.race.volatile", "description": "Report races for volatile variables.", "type": "boolean", @@ -1087,7 +1193,7 @@ }, "additionalProperties": false }, - "dead-code" : { + "dead-code": { "title": "ana.dead-code", "type": "object", "properties": { @@ -1112,7 +1218,7 @@ }, "additionalProperties": false }, - "extract-pthread" : { + "extract-pthread": { "title": "ana.extract-pthread", "type": "object", "properties": { @@ -1154,11 +1260,15 @@ "type": "boolean", "default": true }, - "precise_join": { - "title": "ana.c2po.precise_join", - "description": "If true, the C-2PO Analysis uses a more precise version of the join algorithm, by using the automaton to compute the join.", - "type": "boolean", - "default": false + "join_algorithm": { + "title": "ana.c2po.join_algorithm", + "description": "Which join algorithm 'c2po' should use. Values: 'partition' (default): the more efficient version, it uses only the partition to compute the join. Circular equalities are lost during the join; 'partition': a more precise version, uses the automaton to compute the join.", + "type": "string", + "enum": [ + "precise", + "partition" + ], + "default": "partition" }, "normal_form": { "title": "ana.c2po.normal_form", @@ -1192,8 +1302,7 @@ "properties": { "load": { "title": "incremental.load", - "description": - "Load incremental analysis results, in case any exist.", + "description": "Load incremental analysis results, in case any exist.", "type": "boolean", "default": false }, @@ -1205,8 +1314,7 @@ }, "only-rename": { "title": "incremental.only-rename", - "description": - "Only reset IDs of unchanged objects in the AST. Do not reuse solver results. This option is mainly useful for benchmarking purposes.", + "description": "Only reset IDs of unchanged objects in the AST. Do not reuse solver results. This option is mainly useful for benchmarking purposes.", "type": "boolean", "default": false }, @@ -1224,15 +1332,13 @@ }, "stable": { "title": "incremental.stable", - "description": - "Reuse the stable set and selectively destabilize it (recommended).", + "description": "Reuse the stable set and selectively destabilize it (recommended).", "type": "boolean", "default": true }, "wpoint": { "title": "incremental.wpoint", - "description": - "Reuse the wpoint set (not recommended). Reusing the wpoint will combine existing results at previous widening points.", + "description": "Reuse the wpoint set (not recommended). Reusing the wpoint will combine existing results at previous widening points.", "type": "boolean", "default": false }, @@ -1242,8 +1348,7 @@ "properties": { "enabled": { "title": "incremental.reluctant.enabled", - "description": - "Destabilize nodes in changed functions reluctantly", + "description": "Destabilize nodes in changed functions reluctantly", "type": "boolean", "default": false } @@ -1252,16 +1357,18 @@ }, "compare": { "title": "incremental.compare", - "description": - "Which comparison should be used for functions? 'ast'/'cfg' (cfg comparison also differentiates which nodes of a function have changed)", + "description": "Which comparison should be used for functions? 'ast'/'cfg' (cfg comparison also differentiates which nodes of a function have changed)", "type": "string", - "enum": ["ast", "cfg"], + "enum": [ + "ast", + "cfg" + ], "default": "ast" }, "detect-renames": { "title": "incremental.detect-renames", "description": "If Goblint should try to detect renamed local variables, function parameters, functions and global variables", - "type":"boolean", + "type": "boolean", "default": true }, "force-reanalyze": { @@ -1270,8 +1377,7 @@ "properties": { "funs": { "title": "incremental.force-reanalyze.funs", - "description": - "List of functions that are to be re-analayzed from scratch", + "description": "List of functions that are to be re-analayzed from scratch", "type": "array", "items": { "type": "string" @@ -1299,7 +1405,11 @@ "title": "incremental.restart.sided.vars", "description": "Side-effected variables to restart. Globals are non-function entry nodes. Write-only is a subset of globals.", "type": "string", - "enum": ["all", "global", "write-only"], + "enum": [ + "all", + "global", + "write-only" + ], "default": "all" }, "fuel": { @@ -1337,7 +1447,7 @@ }, "postsolver": { "title": "incremental.postsolver", - "type" : "object", + "type": "object", "properties": { "enabled": { "title": "incremental.postsolver.enabled", @@ -1345,8 +1455,8 @@ "type": "boolean", "default": true }, - "superstable-reached" : { - "title": "incremental.postsolver.superstable-reached", + "superstable-reached": { + "title": "incremental.postsolver.superstable-reached", "description": "Consider superstable set reached, may be faster but can lead to spurious warnings", "type": "boolean", "default": false @@ -1413,15 +1523,13 @@ "properties": { "spawn": { "title": "sem.unknown_function.spawn", - "description": - "Unknown function call spawns reachable functions", + "description": "Unknown function call spawns reachable functions", "type": "boolean", "default": true }, "call": { "title": "sem.unknown_function.call", - "description": - "Unknown function call calls reachable functions", + "description": "Unknown function call calls reachable functions", "type": "boolean", "default": true }, @@ -1431,15 +1539,13 @@ "properties": { "globals": { "title": "sem.unknown_function.invalidate.globals", - "description": - "Unknown function call invalidates all globals", + "description": "Unknown function call invalidates all globals", "type": "boolean", "default": true }, "args": { "title": "sem.unknown_function.invalidate.args", - "description": - "Unknown function call invalidates arguments passed to it", + "description": "Unknown function call invalidates arguments passed to it", "type": "boolean", "default": true } @@ -1452,8 +1558,7 @@ "properties": { "args": { "title": "sem.unknown_function.read.args", - "description": - "Unknown function call reads arguments passed to it", + "description": "Unknown function call reads arguments passed to it", "type": "boolean", "default": true } @@ -1469,8 +1574,7 @@ "properties": { "dead_code": { "title": "sem.builtin_unreachable.dead_code", - "description": - "__builtin_unreachable is assumed to be dead code", + "description": "__builtin_unreachable is assumed to be dead code", "type": "boolean", "default": false } @@ -1484,8 +1588,7 @@ "properties": { "dead_code": { "title": "sem.noreturn.dead_code", - "description": - "For the purposes of detecting dead code, assume that functions marked noreturn don't return.", + "description": "For the purposes of detecting dead code, assume that functions marked noreturn don't return.", "type": "boolean", "default": false } @@ -1498,10 +1601,13 @@ "properties": { "signed_overflow": { "title": "sem.int.signed_overflow", - "description": - "How to handle overflows of signed types. Values: 'assume_top' (default): Assume signed overflow results in a top value; 'assume_none': Assume program is free of signed overflows; 'assume_wraparound': Assume signed types wrap-around and two's complement representation of signed integers", + "description": "How to handle overflows of signed types. Values: 'assume_top' (default): Assume signed overflow results in a top value; 'assume_none': Assume program is free of signed overflows; 'assume_wraparound': Assume signed types wrap-around and two's complement representation of signed integers", "type": "string", - "enum": ["assume_top", "assume_none", "assume_wraparound"], + "enum": [ + "assume_top", + "assume_none", + "assume_wraparound" + ], "default": "assume_top" } }, @@ -1515,7 +1621,10 @@ "title": "sem.null-pointer.dereference", "description": "NULL pointer dereference handling. assume_top: assume it results in a top value, assume_none: assume it doesn't happen", "type": "string", - "enum": ["assume_top", "assume_none"], + "enum": [ + "assume_top", + "assume_none" + ], "default": "assume_none" } }, @@ -1527,8 +1636,7 @@ "properties": { "fail": { "title": "sem.malloc.fail", - "description": - "Consider the case where malloc or calloc fails.", + "description": "Consider the case where malloc or calloc fails.", "type": "boolean", "default": false } @@ -1541,8 +1649,7 @@ "properties": { "fail": { "title": "sem.lock.fail", - "description": - "Takes the possible failing of locking operations into account.", + "description": "Takes the possible failing of locking operations into account.", "type": "boolean", "default": false } @@ -1572,12 +1679,16 @@ "properties": { "activated": { "title": "trans.activated", - "description": - "Lists of activated transformations. Transformations happen after analyses.", + "description": "Lists of activated transformations. Transformations happen after analyses.", "type": "array", "items": { "type": "string", - "enum": ["partial", "expeval", "assert", "remove_dead_code"] + "enum": [ + "partial", + "expeval", + "assert", + "remove_dead_code" + ] }, "default": [] }, @@ -1587,21 +1698,20 @@ "properties": { "query_file_name": { "title": "trans.expeval.query_file_name", - "description": - "Path to the JSON file containing an expression evaluation query.", + "description": "Path to the JSON file containing an expression evaluation query.", "type": "string", "default": "" } }, "additionalProperties": false }, - "output" : { + "output": { "title": "trans.output", "description": "Output filename for transformations that output a transformed file.", - "type":"string", + "type": "string", "default": "transformed.c" }, - "assert" : { + "assert": { "title": "trans.assert", "type": "object", "properties": { @@ -1609,7 +1719,11 @@ "title": "trans.assert.function", "description": "Function to use for assertions in output.", "type": "string", - "enum": ["assert", "__goblint_check", "__VERIFIER_assert"], + "enum": [ + "assert", + "__goblint_check", + "__VERIFIER_assert" + ], "default": "__VERIFIER_assert" }, "wrap-atomic": { @@ -1635,15 +1749,13 @@ "properties": { "enabled": { "title": "annotation.int.enabled", - "description": - "Enable manual annotation of functions with desired precision, i.e., the activated IntDomains.", + "description": "Enable manual annotation of functions with desired precision, i.e., the activated IntDomains.", "type": "boolean", "default": false }, "privglobs": { "title": "annotation.int.privglobs", - "description": - "Enables handling of privatized globals, by setting the precision to the heighest value, when annotation.int.enabled is true.", + "description": "Enables handling of privatized globals, by setting the precision to the heighest value, when annotation.int.enabled is true.", "type": "boolean", "default": true } @@ -1656,8 +1768,7 @@ "properties": { "enabled": { "title": "annotation.float.enabled", - "description": - "Enable manual annotation of functions with desired precision, i.e., the activated FloatDomains.", + "description": "Enable manual annotation of functions with desired precision, i.e., the activated FloatDomains.", "type": "boolean", "default": false } @@ -1671,7 +1782,20 @@ "type": "array", "items": { "type": "string", - "enum": ["base.no-non-ptr", "base.non-ptr", "base.no-int", "base.int", "base.no-interval", "base.no-interval_set","base.interval", "base.interval_set","relation.no-context", "relation.context", "no-widen", "widen"] + "enum": [ + "base.no-non-ptr", + "base.non-ptr", + "base.no-int", + "base.int", + "base.no-interval", + "base.no-interval_set", + "base.interval", + "base.interval_set", + "relation.no-context", + "relation.context", + "no-widen", + "widen" + ] }, "default": [] } @@ -1683,7 +1807,16 @@ "type": "array", "items": { "type": "string", - "enum": ["no-def_exc", "def_exc", "no-interval", "interval", "no-enums", "enums", "no-congruence", "congruence"] + "enum": [ + "no-def_exc", + "def_exc", + "no-interval", + "interval", + "no-enums", + "enums", + "no-congruence", + "congruence" + ] }, "default": [] } @@ -1716,8 +1849,7 @@ }, "priv-distr-init": { "title": "exp.priv-distr-init", - "description": - "Distribute global initializations to all global invariants for more consistent widening dynamics.", + "description": "Distribute global initializations to all global invariants for more consistent widening dynamics.", "type": "boolean", "default": false }, @@ -1748,8 +1880,7 @@ }, "earlyglobs": { "title": "exp.earlyglobs", - "description": - "Side-effecting of globals right after initialization.", + "description": "Side-effecting of globals right after initialization.", "type": "boolean", "default": false }, @@ -1763,20 +1894,20 @@ "title": "exp.unique", "description": "For types that have only one value.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "forward": { "title": "exp.forward", - "description": - "Use implicit forward propagation instead of the demand driven approach.", + "description": "Use implicit forward propagation instead of the demand driven approach.", "type": "boolean", "default": false }, "volatiles_are_top": { "title": "exp.volatiles_are_top", - "description": - "volatile and extern keywords set variables permanently to top", + "description": "volatile and extern keywords set variables permanently to top", "type": "boolean", "default": true }, @@ -1794,18 +1925,20 @@ }, "exclude_from_earlyglobs": { "title": "exp.exclude_from_earlyglobs", - "description": - "Global variables that should be handled flow-sensitively when using earlyglobs.", + "description": "Global variables that should be handled flow-sensitively when using earlyglobs.", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, - "exclude_from_invalidation" : { + "exclude_from_invalidation": { "title": "exp.exclude_from_invalidation", - "description": - "Global variables that should not be invalidated. This assures the analysis that such globals are only modified through known code", + "description": "Global variables that should not be invalidated. This assures the analysis that such globals are only modified through known code", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "g2html_path": { @@ -1816,10 +1949,11 @@ }, "extraspecials": { "title": "exp.extraspecials", - "description": - "List of functions that must be analyzed as unknown extern functions", + "description": "List of functions that must be analyzed as unknown extern functions", "type": "array", - "items": { "type": "string" }, + "items": { + "type": "string" + }, "default": [] }, "no-narrow": { @@ -1830,15 +1964,13 @@ }, "basic-blocks": { "title": "exp.basic-blocks", - "description": - "Only keep values for basic blocks instead of for every node. Should take longer but need less space.", + "description": "Only keep values for basic blocks instead of for every node. Should take longer but need less space.", "type": "boolean", "default": false }, "fast_global_inits": { "title": "exp.fast_global_inits", - "description": - "Only generate one 'a[any_index] = x' for all assignments a[...] = x for a global array a[n].", + "description": "Only generate one 'a[any_index] = x' for all assignments a[...] = x for a global array a[n].", "type": "boolean", "default": true }, @@ -1846,27 +1978,27 @@ "title": "exp.architecture", "description": "Architecture for analysis, currently for witness", "type": "string", - "enum": ["64bit", "32bit"], + "enum": [ + "64bit", + "32bit" + ], "default": "64bit" }, "gcc_path": { "title": "exp.gcc_path", - "description": - "Location of gcc. Used to combine source files with cilly. Change to gcc-9 or another version on OS X (with gcc being clang by default cilly will fail otherwise).", + "description": "Location of gcc. Used to combine source files with cilly. Change to gcc-9 or another version on OS X (with gcc being clang by default cilly will fail otherwise).", "type": "string", "default": "/usr/bin/gcc" }, "cpp-path": { "title": "exp.cpp-path", - "description": - "Path to C preprocessor (cpp) to use. If empty, then automatically searched.", + "description": "Path to C preprocessor (cpp) to use. If empty, then automatically searched.", "type": "string", "default": "" }, "unrolling-factor": { "title": "exp.unrolling-factor", - "description": - "Sets the unrolling factor for the loopUnrollingVisitor.", + "description": "Sets the unrolling factor for the loopUnrollingVisitor.", "type": "integer", "default": 0 }, @@ -1902,7 +2034,10 @@ "title": "exp.arg.dot.node-label", "description": "Which ARG node labels to use? node/empty", "type": "string", - "enum": ["node", "empty"], + "enum": [ + "node", + "empty" + ], "default": "node" } }, @@ -1923,7 +2058,13 @@ "title": "dbg.level", "description": "Logging level.", "type": "string", - "enum": ["debug", "info", "warning", "error", "result"], + "enum": [ + "debug", + "info", + "warning", + "error", + "result" + ], "default": "info" }, "timing": { @@ -1974,48 +2115,45 @@ "title": "dbg.justcil-printer", "description": "Printer to use for justcil: default, or clean (excludes line directives and builtin declarations).", "type": "string", - "enum": ["default", "clean"], + "enum": [ + "default", + "clean" + ], "default": "default" }, "timeout": { "title": "dbg.timeout", - "description": - "Stop solver after this time. 0 means no timeout. Supports optional units h, m, s. E.g. 1m6s = 01m06s = 66; 6h = 6*60*60.", + "description": "Stop solver after this time. 0 means no timeout. Supports optional units h, m, s. E.g. 1m6s = 01m06s = 66; 6h = 6*60*60.", "type": "string", "default": "0" }, "solver-stats-interval": { "title": "dbg.solver-stats-interval", - "description": - "Interval in seconds to print statistics while solving. Set to 0 to deactivate.", + "description": "Interval in seconds to print statistics while solving. Set to 0 to deactivate.", "type": "integer", "default": 10 }, "solver-signal": { "title": "dbg.solver-signal", - "description": - "Signal to print statistics while solving. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", + "description": "Signal to print statistics while solving. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", "type": "string", "default": "sigusr1" }, "backtrace-signal": { "title": "dbg.backtrace-signal", - "description": - "Signal to print a raw backtrace on stderr. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", + "description": "Signal to print a raw backtrace on stderr. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", "type": "string", "default": "sigusr2" }, "solver-progress": { "title": "dbg.solver-progress", - "description": - "Used for debugging. Prints out a symbol on solving a rhs.", + "description": "Used for debugging. Prints out a symbol on solving a rhs.", "type": "boolean", "default": false }, "print_wpoints": { "title": "dbg.print_wpoints", - "description": - "Print the widening points after solving (does not include the removed wpoints during solving by the slr solvers). Currently only implemented in: slr*, td3.", + "description": "Print the widening points after solving (does not include the removed wpoints during solving by the slr solvers). Currently only implemented in: slr*, td3.", "type": "boolean", "default": false }, @@ -2044,8 +2182,7 @@ "properties": { "widen": { "title": "dbg.limit.widen", - "description": - "Limit for number of widenings per node (0 = no limit).", + "description": "Limit for number of widenings per node (0 = no limit).", "type": "integer", "default": 0 } @@ -2054,15 +2191,13 @@ }, "warn_with_context": { "title": "dbg.warn_with_context", - "description": - "Keep warnings for different contexts apart (currently only done for asserts).", + "description": "Keep warnings for different contexts apart (currently only done for asserts).", "type": "boolean", "default": false }, "regression": { "title": "dbg.regression", - "description": - "Only output warnings for assertions that have an unexpected result (no comment, comment FAIL, comment UNKNOWN)", + "description": "Only output warnings for assertions that have an unexpected result (no comment, comment FAIL, comment UNKNOWN)", "type": "boolean", "default": false }, @@ -2143,22 +2278,19 @@ }, "print_tids": { "title": "dbg.print_tids", - "description": - "Should the analysis print information on the encountered TIDs", + "description": "Should the analysis print information on the encountered TIDs", "type": "boolean", "default": false }, "print_protection": { "title": "dbg.print_protection", - "description": - "Should the analysis print information on which globals are protected by which mutex?", + "description": "Should the analysis print information on which globals are protected by which mutex?", "type": "boolean", "default": false }, - "run_cil_check" : { + "run_cil_check": { "title": "dbg.run_cil_check", - "description": - "Should the analysis call Check.checkFile after creating the CFG (helpful to verify that transformations respect CIL's invariants.", + "description": "Should the analysis call Check.checkFile after creating the CFG (helpful to verify that transformations respect CIL's invariants.", "type": "boolean", "default": false }, @@ -2322,7 +2454,7 @@ }, "memleak": { "title": "warn.memleak", - "type":"object", + "type": "object", "properties": { "memcleanup": { "title": "warn.memleak.memcleanup", @@ -2352,23 +2484,29 @@ "properties": { "term": { "title": "solvers.td3.term", - "description": - "Should the td3 solver use the phased/terminating strategy?", + "description": "Should the td3 solver use the phased/terminating strategy?", "type": "boolean", "default": true }, "side_widen": { "title": "solvers.td3.side_widen", - "description": - "When to widen in side. never: never widen, always: always widen, sides: widen if there are multiple side-effects from the same var resulting in a new value, cycle: widen if a called or a start var get destabilized, unstable_called: widen if any called var gets destabilized, unstable_self: widen if side-effected var gets destabilized, sides-pp: widen if there are multiple side-effects from the same program point resulting in a new value, sides-local: Widen with contributions from variables from which multiple side-effects leading to a new value originate.", + "description": "When to widen in side. never: never widen, always: always widen, sides: widen if there are multiple side-effects from the same var resulting in a new value, cycle: widen if a called or a start var get destabilized, unstable_called: widen if any called var gets destabilized, unstable_self: widen if side-effected var gets destabilized, sides-pp: widen if there are multiple side-effects from the same program point resulting in a new value, sides-local: Widen with contributions from variables from which multiple side-effects leading to a new value originate.", "type": "string", - "enum": ["never", "always", "sides", "cycle", "unstable_called", "unstable_self", "sides-pp","sides-local"], + "enum": [ + "never", + "always", + "sides", + "cycle", + "unstable_called", + "unstable_self", + "sides-pp", + "sides-local" + ], "default": "sides" }, "space": { "title": "solvers.td3.space", - "description": - "Should the td3 solver only keep values at widening points?", + "description": "Should the td3 solver only keep values at widening points?", "type": "boolean", "default": false }, @@ -2380,8 +2518,7 @@ }, "space_restore": { "title": "solvers.td3.space_restore", - "description": - "Should the td3-space solver restore values for non-widening-points? Not needed for generating warnings, but needed for inspecting output!", + "description": "Should the td3-space solver restore values for non-widening-points? Not needed for generating warnings, but needed for inspecting output!", "type": "boolean", "default": true }, @@ -2397,10 +2534,10 @@ "type": "boolean", "default": true }, - "skip-unchanged-rhs" : { - "title" : "solvers.td3.skip-unchanged-rhs", - "description" : "Skip evaluation of RHS if all dependencies are unchanged - INCOMPATIBLE WITH RESTARTING", - "type" : "boolean", + "skip-unchanged-rhs": { + "title": "solvers.td3.skip-unchanged-rhs", + "description": "Skip evaluation of RHS if all dependencies are unchanged - INCOMPATIBLE WITH RESTARTING", + "type": "boolean", "default": false }, "restart": { @@ -2444,8 +2581,7 @@ "properties": { "restart_count": { "title": "solvers.slr4.restart_count", - "description": - "How many times SLR4 is allowed to switch from restarting iteration to increasing iteration.", + "description": "How many times SLR4 is allowed to switch from restarting iteration to increasing iteration.", "type": "integer", "default": 1 } @@ -2479,7 +2615,10 @@ "title": "witness.graphml.id", "description": "Which witness node IDs to use? node/enumerate", "type": "string", - "enum": ["node", "enumerate"], + "enum": [ + "node", + "enumerate" + ], "default": "node" }, "minimize": { @@ -2490,8 +2629,7 @@ }, "uncil": { "title": "witness.graphml.uncil", - "description": - "Try to undo CIL control flow transformations in witness", + "description": "Try to undo CIL control flow transformations in witness", "type": "boolean", "default": false }, @@ -2516,22 +2654,19 @@ "properties": { "loop-head": { "title": "witness.invariant.loop-head", - "description": - "Emit invariants at loop heads", + "description": "Emit invariants at loop heads", "type": "boolean", "default": true }, "after-lock": { "title": "witness.invariant.after-lock", - "description": - "Emit invariants after mutex locking", + "description": "Emit invariants after mutex locking", "type": "boolean", "default": true }, "other": { "title": "witness.invariant.other", - "description": - "Emit invariants at all other locations", + "description": "Emit invariants at all other locations", "type": "boolean", "default": true }, @@ -2549,8 +2684,7 @@ }, "full": { "title": "witness.invariant.full", - "description": - "Whether to dump assertions about all local variables or limitting it to modified ones where possible.", + "description": "Whether to dump assertions about all local variables or limitting it to modified ones where possible.", "type": "boolean", "default": true }, diff --git a/tests/regression/83-c2po/18-complicated-join.c b/tests/regression/83-c2po/18-complicated-join.c index 12c6d94715..ff55e82d94 100644 --- a/tests/regression/83-c2po/18-complicated-join.c +++ b/tests/regression/83-c2po/18-complicated-join.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --enable ana.c2po.precise_join +// PARAM: --set ana.activated[+] c2po --set ana.activated[+] startState --set ana.activated[+] taintPartialContexts --set ana.c2po.join_algorithm precise // Example 1 from the paper Join Algorithms for the Theory of Uninterpreted // Functions by Gulwani et al. From 80f68fcc987535dd26e9c13907f687a19f2979ef Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 12:48:49 +0200 Subject: [PATCH 320/323] make normal_form an enum --- src/cdomains/c2poDomain.ml | 5 +- src/config/options.schema.json | 730 ++++++++++++++------------------- 2 files changed, 306 insertions(+), 429 deletions(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index d96b4dcf61..2b5382c42f 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -43,7 +43,10 @@ module C2PODomain = struct let equal a b = if M.tracing then M.trace "c2po-normal-form" "COMPUTING EQUAL"; - if GobConfig.get_bool "ana.c2po.normal_form" then equal_normal_form a b else equal_standard a b + match GobConfig.get_string "ana.c2po.normal_form" with + | "normal_form" -> equal_normal_form a b + | _ -> equal_standard a b + let equal a b = Timing.wrap "c2po-equal" (equal a) b diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 37f09eb3a1..1f4f7a2592 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -31,7 +31,8 @@ }, "verify": { "title": "verify", - "description": "Verify that the solver reached a post-fixpoint. Beware that disabling this also disables output of warnings since post-processing of the results is done in the verification phase!", + "description": + "Verify that the solver reached a post-fixpoint. Beware that disabling this also disables output of warnings since post-processing of the results is done in the verification phase!", "type": "boolean", "default": true }, @@ -39,34 +40,27 @@ "title": "mainfun", "description": "Sets the name of the main functions.", "type": "array", - "items": { - "type": "string" - }, - "default": [ - "main" - ] + "items": { "type": "string" }, + "default": [ "main" ] }, "exitfun": { "title": "exitfun", "description": "Sets the name of the cleanup functions.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "otherfun": { "title": "otherfun", "description": "Sets the name of other functions.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "allglobs": { "title": "allglobs", - "description": "Prints access information about all globals, not just races.", + "description": + "Prints access information about all globals, not just races.", "type": "boolean", "default": false }, @@ -84,16 +78,10 @@ }, "result": { "title": "result", - "description": "Result style: none, fast_xml, json, pretty, json-messages, sarif.", + "description": + "Result style: none, fast_xml, json, pretty, json-messages, sarif.", "type": "string", - "enum": [ - "none", - "fast_xml", - "json", - "pretty", - "json-messages", - "sarif" - ], + "enum": ["none", "fast_xml", "json", "pretty", "json-messages", "sarif"], "default": "none" }, "solver": { @@ -110,7 +98,8 @@ }, "allfuns": { "title": "allfuns", - "description": "Analyzes all the functions (not just beginning from main). This requires exp.earlyglobs!", + "description": + "Analyzes all the functions (not just beginning from main). This requires exp.earlyglobs!", "type": "boolean", "default": false }, @@ -122,13 +111,10 @@ }, "colors": { "title": "colors", - "description": "Colored output (via ANSI escape codes). 'auto': enabled if stdout is a terminal (instead of a pipe); 'always', 'never'.", + "description": + "Colored output (via ANSI escape codes). 'auto': enabled if stdout is a terminal (instead of a pipe); 'always', 'never'.", "type": "string", - "enum": [ - "auto", - "always", - "never" - ], + "enum": ["auto", "always", "never"], "default": "auto" }, "g2html": { @@ -139,7 +125,8 @@ }, "save_run": { "title": "save_run", - "description": "Save the result of the solver, the current configuration and meta-data about the run to this directory (if set). The data can then be loaded (without solving again) to do post-processing like generating output in a different format or comparing results.", + "description": + "Save the result of the solver, the current configuration and meta-data about the run to this directory (if set). The data can then be loaded (without solving again) to do post-processing like generating output in a different format or comparing results.", "type": "string", "default": "" }, @@ -151,27 +138,24 @@ }, "compare_runs": { "title": "compare_runs", - "description": "Load these saved runs and compare the results. Note that currently only two runs can be compared!", + "description": + "Load these saved runs and compare the results. Note that currently only two runs can be compared!", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "warn_at": { "title": "warn_at", - "description": "When to output warnings. Values: 'post' (default): after solving; 'never': no warnings; 'early': for debugging - outputs warnings already while solving (may lead to spurious warnings/asserts that would disappear after narrowing).", + "description": + "When to output warnings. Values: 'post' (default): after solving; 'never': no warnings; 'early': for debugging - outputs warnings already while solving (may lead to spurious warnings/asserts that would disappear after narrowing).", "type": "string", - "enum": [ - "post", - "never", - "early" - ], + "enum": ["post", "never", "early"], "default": "post" }, "gobview": { "title": "gobview", - "description": "Include additional information for GobView (e.g., the Goblint warning messages) in the directory specified by 'save_run'.", + "description": + "Include additional information for GobView (e.g., the Goblint warning messages) in the directory specified by 'save_run'.", "type": "boolean", "default": false }, @@ -200,7 +184,8 @@ }, "keep": { "title": "pre.keep", - "description": "Keep the intermediate output of running the C preprocessor.", + "description": + "Keep the intermediate output of running the C preprocessor.", "type": "boolean", "default": false }, @@ -214,27 +199,21 @@ "title": "pre.includes", "description": "List of directories to include.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "kernel_includes": { "title": "pre.kernel_includes", "description": "List of kernel directories to include.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "custom_includes": { "title": "pre.custom_includes", "description": "List of custom directories to include.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "kernel-root": { @@ -247,9 +226,7 @@ "title": "pre.cppflags", "description": "Pre-processing parameters.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "compdb": { @@ -258,7 +235,8 @@ "properties": { "original-path": { "title": "pre.compdb.original-path", - "description": "Original absolute path of Compilation Database. Used to reroot all absolute paths in there if moved, e.g. in container mounts.", + "description": + "Original absolute path of Compilation Database. Used to reroot all absolute paths in there if moved, e.g. in container mounts.", "type": "string", "default": "" }, @@ -303,11 +281,7 @@ "type": "string", "description": "Specify the c standard used for parsing.", "default": "c99", - "enum": [ - "c90", - "c99", - "c11" - ] + "enum": ["c90", "c99", "c11"] }, "gnu89inline": { "title": "cil.gnu89inline", @@ -339,10 +313,7 @@ "title": "server.mode", "description": "Server transport mode", "type": "string", - "enum": [ - "stdio", - "unix" - ], + "enum": ["stdio", "unix"], "default": "stdio" }, "unix-socket": { @@ -369,64 +340,35 @@ "title": "ana.activated", "description": "Lists of activated analyses.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [ - "expRelation", - "base", - "threadid", - "threadflag", - "threadreturn", - "escape", - "mutexEvents", - "mutex", - "access", - "race", - "mallocWrapper", - "mhp", - "assert", - "pthreadMutexType" + "expRelation", "base", "threadid", "threadflag", "threadreturn", + "escape", "mutexEvents", "mutex", "access", "race", "mallocWrapper", "mhp", + "assert", "pthreadMutexType" ] }, "path_sens": { "title": "ana.path_sens", "description": "List of path-sensitive analyses", "type": "array", - "items": { - "type": "string" - }, - "default": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak" - ] + "items": { "type": "string" }, + "default": [ "mutex", "malloc_null", "uninit", "expsplit","activeSetjmp","memLeak" ] }, "ctx_insens": { "title": "ana.ctx_insens", "description": "List of context-insensitive analyses. This setting is ignored if `ana.ctx_sens` contains elements.", "type": "array", - "items": { - "type": "string" - }, - "default": [ - "stack_loc", - "stack_trace_set" - ] + "items": { "type": "string" }, + "default": [ "stack_loc", "stack_trace_set" ] }, "ctx_sens": { "title": "ana.ctx_sens", "description": "List of context-sensitive analyses. In case this list is empty, `ana.ctx_insens` will be used to determine the set of context-insensitive analyses.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, - "setjmp": { + "setjmp" : { "title": "ana.setjmp", "description": "Setjmp/Longjmp analysis", "type": "object", @@ -435,11 +377,7 @@ "title": "ana.setjmp.split", "description": "Split returns of setjmp", "type": "string", - "enum": [ - "none", - "coarse", - "precise" - ], + "enum": ["none", "coarse", "precise"], "default": "precise" } }, @@ -451,13 +389,15 @@ "properties": { "def_exc": { "title": "ana.int.def_exc", - "description": "Use IntDomain.DefExc: definite value/exclusion set.", + "description": + "Use IntDomain.DefExc: definite value/exclusion set.", "type": "boolean", "default": true }, "interval": { "title": "ana.int.interval", - "description": "Use IntDomain.Interval32: (Z.t * Z.t) option.", + "description": + "Use IntDomain.Interval32: (Z.t * Z.t) option.", "type": "boolean", "default": false }, @@ -469,30 +409,30 @@ }, "enums": { "title": "ana.int.enums", - "description": "Use IntDomain.Enums: Inclusion/Exclusion sets. Go to top on arithmetic operations (except for some easy cases, e.g. multiplication with 0). Joins on widen, i.e. precise integers as long as not derived from arithmetic expressions.", + "description": + "Use IntDomain.Enums: Inclusion/Exclusion sets. Go to top on arithmetic operations (except for some easy cases, e.g. multiplication with 0). Joins on widen, i.e. precise integers as long as not derived from arithmetic expressions.", "type": "boolean", "default": false }, "congruence": { "title": "ana.int.congruence", - "description": "Use IntDomain.Congruence: (c, m) option, meaning congruent to c modulo m", + "description": + "Use IntDomain.Congruence: (c, m) option, meaning congruent to c modulo m", "type": "boolean", "default": false }, "refinement": { "title": "ana.int.refinement", - "description": "Use mutual refinement of integer domains. Either 'never', 'once' or 'fixpoint'. Counterintuitively, may reduce precision unless ana.int.interval_narrow_by_meet is also enabled.", + "description": + "Use mutual refinement of integer domains. Either 'never', 'once' or 'fixpoint'. Counterintuitively, may reduce precision unless ana.int.interval_narrow_by_meet is also enabled.", "type": "string", - "enum": [ - "never", - "once", - "fixpoint" - ], + "enum": ["never", "once", "fixpoint"], "default": "never" }, "def_exc_widen_by_join": { "title": "ana.int.def_exc_widen_by_join", - "description": "Perform def_exc widening by joins. Gives threshold-widening like behavior, with thresholds given by the ranges of different integer types.", + "description": + "Perform def_exc widening by joins. Gives threshold-widening like behavior, with thresholds given by the ranges of different integer types.", "type": "boolean", "default": false }, @@ -504,18 +444,17 @@ }, "interval_threshold_widening": { "title": "ana.int.interval_threshold_widening", - "description": "Use constants appearing in program as threshold for widening", + "description": + "Use constants appearing in program as threshold for widening", "type": "boolean", "default": false }, "interval_threshold_widening_constants": { "title": "ana.int.interval_threshold_widening_constants", - "description": "Which constants in the program should be considered as threshold constants (all/comparisons)", + "description": + "Which constants in the program should be considered as threshold constants (all/comparisons)", "type": "string", - "enum": [ - "all", - "comparisons" - ], + "enum": ["all", "comparisons"], "default": "all" } }, @@ -527,13 +466,15 @@ "properties": { "interval": { "title": "ana.float.interval", - "description": "Use FloatDomain: (float * float) option.", + "description": + "Use FloatDomain: (float * float) option.", "type": "boolean", "default": false }, "evaluate_math_functions": { "title": "ana.float.evaluate_math_functions", - "description": "Allow a more precise evaluation of some functions from math.h. Evaluation of functions may differ depending on the implementation of math.h. Caution: For some implementations of functions it is not guaranteed that they behave monotonic where they mathematically should, thus possibly leading to unsoundness.", + "description": + "Allow a more precise evaluation of some functions from math.h. Evaluation of functions may differ depending on the implementation of math.h. Caution: For some implementations of functions it is not guaranteed that they behave monotonic where they mathematically should, thus possibly leading to unsoundness.", "type": "boolean", "default": false } @@ -546,7 +487,8 @@ "properties": { "debug": { "title": "ana.pml.debug", - "description": "Insert extra assertions into Promela code for debugging.", + "description": + "Insert extra assertions into Promela code for debugging.", "type": "boolean", "default": true } @@ -559,13 +501,15 @@ "properties": { "hashcons": { "title": "ana.opt.hashcons", - "description": "Should we try to save memory and speed up equality by hashconsing?", + "description": + "Should we try to save memory and speed up equality by hashconsing?", "type": "boolean", "default": true }, "equal": { "title": "ana.opt.equal", - "description": "First try physical equality (==) before {D,G,C}.equal (only done if hashcons is disabled since it basically does the same via its tags).", + "description": + "First try physical equality (==) before {D,G,C}.equal (only done if hashcons is disabled since it basically does the same via its tags).", "type": "boolean", "default": true } @@ -651,7 +595,8 @@ }, "wp": { "title": "ana.wp", - "description": "Weakest precondition feasibility analysis for SV-COMP violations", + "description": + "Weakest precondition feasibility analysis for SV-COMP violations", "type": "boolean", "default": false }, @@ -683,13 +628,15 @@ }, "interval": { "title": "ana.base.context.interval", - "description": "Integer values of the Interval domain in function contexts.", + "description": + "Integer values of the Interval domain in function contexts.", "type": "boolean", "default": true }, "interval_set": { "title": "ana.base.context.interval_set", - "description": "Integer values of the IntervalSet domain in function contexts.", + "description": + "Integer values of the IntervalSet domain in function contexts.", "type": "boolean", "default": true } @@ -704,11 +651,7 @@ "title": "ana.base.strings.domain", "description": "Domain for string literals.", "type": "string", - "enum": [ - "unit", - "flat", - "disjoint" - ], + "enum": ["unit", "flat", "disjoint"], "default": "flat" } }, @@ -720,42 +663,39 @@ "properties": { "keep-expr": { "title": "ana.base.partition-arrays.keep-expr", - "description": "When using the partitioning which expression should be used for partitioning ('first', 'last')", + "description": + "When using the partitioning which expression should be used for partitioning ('first', 'last')", "type": "string", - "enum": [ - "first", - "last" - ], + "enum": ["first", "last"], "default": "first" }, "partition-by-const-on-return": { "title": "ana.base.partition-arrays.partition-by-const-on-return", - "description": "When using the partitioning should arrays be considered partitioned according to a constant if a var in the expression used for partitioning goes out of scope?", + "description": + "When using the partitioning should arrays be considered partitioned according to a constant if a var in the expression used for partitioning goes out of scope?", "type": "boolean", "default": false }, "smart-join": { "title": "ana.base.partition-arrays.smart-join", - "description": "When using the partitioning should the join of two arrays partitioned according to different expressions be partitioned as well if possible? If keep-expr is 'last' this behavior is enabled regardless of the flag value. Caution: Not always advantageous.", + "description": + "When using the partitioning should the join of two arrays partitioned according to different expressions be partitioned as well if possible? If keep-expr is 'last' this behavior is enabled regardless of the flag value. Caution: Not always advantageous.", "type": "boolean", "default": false } }, "additionalProperties": false }, - "arrays": { + "arrays":{ "title": "ana.base.arrays", "type": "object", "properties": { "domain": { "title": "ana.base.arrays.domain", - "description": "The domain that should be used for arrays. When employing the partition array domain, make sure to enable the expRelation analysis as well. When employing the unrolling array domain, make sure to set the ana.base.arrays.unrolling-factor >0.", + "description": + "The domain that should be used for arrays. When employing the partition array domain, make sure to enable the expRelation analysis as well. When employing the unrolling array domain, make sure to set the ana.base.arrays.unrolling-factor >0.", "type": "string", - "enum": [ - "trivial", - "partitioned", - "unroll" - ], + "enum": ["trivial", "partitioned", "unroll"], "default": "trivial" }, "unrolling-factor": { @@ -779,15 +719,10 @@ "properties": { "domain": { "title": "ana.base.structs.domain", - "description": "The domain that should be used for structs. simple/sets/keyed/combined-all/combined-sk", + "description": + "The domain that should be used for structs. simple/sets/keyed/combined-all/combined-sk", "type": "string", - "enum": [ - "simple", - "sets", - "keyed", - "combined-all", - "combined-sk" - ], + "enum": ["simple", "sets", "keyed", "combined-all", "combined-sk"], "default": "simple" }, "key": { @@ -796,19 +731,22 @@ "properties": { "forward": { "title": "ana.base.structs.key.forward", - "description": "Whether the struct key should be picked going from first field to last.", + "description": + "Whether the struct key should be picked going from first field to last.", "type": "boolean", "default": true }, "avoid-ints": { "title": "ana.base.structs.key.avoid-ints", - "description": "Whether integers should be avoided for key.", + "description": + "Whether integers should be avoided for key.", "type": "boolean", "default": true }, "prefer-ptrs": { "title": "ana.base.structs.key.prefer-ptrs", - "description": "Whether pointers should be preferred for key.", + "description": + "Whether pointers should be preferred for key.", "type": "boolean", "default": true } @@ -820,30 +758,10 @@ }, "privatization": { "title": "ana.base.privatization", - "description": "Which privatization to use? none/mutex-oplus/mutex-meet/mutex-meet-tid/protection/protection-read/mine/mine-nothread/mine-W/mine-W-noinit/lock/lock-tid/write/write-tid/write+lock/write+lock-tid", + "description": + "Which privatization to use? none/mutex-oplus/mutex-meet/mutex-meet-tid/protection/protection-read/mine/mine-nothread/mine-W/mine-W-noinit/lock/lock-tid/write/write-tid/write+lock/write+lock-tid", "type": "string", - "enum": [ - "none", - "mutex-oplus", - "mutex-meet", - "protection", - "protection-tid", - "protection-atomic", - "protection-read", - "protection-read-tid", - "protection-read-atomic", - "mine", - "mine-nothread", - "mine-W", - "mine-W-noinit", - "lock", - "lock-tid", - "write", - "write-tid", - "write+lock", - "write+lock-tid", - "mutex-meet-tid" - ], + "enum": ["none", "mutex-oplus", "mutex-meet", "protection", "protection-tid", "protection-atomic", "protection-read", "protection-read-tid", "protection-read-atomic", "mine", "mine-nothread", "mine-W", "mine-W-noinit", "lock", "lock-tid", "write", "write-tid", "write+lock", "write+lock-tid", "mutex-meet-tid"], "default": "protection-read" }, "priv": { @@ -852,13 +770,15 @@ "properties": { "not-started": { "title": "ana.base.priv.not-started", - "description": "Exclude writes from threads that may not be started yet", + "description": + "Exclude writes from threads that may not be started yet", "type": "boolean", "default": true }, "must-joined": { "title": "ana.base.priv.must-joined", - "description": "Exclude writes from threads that must have been joined", + "description": + "Exclude writes from threads that must have been joined", "type": "boolean", "default": true } @@ -885,10 +805,7 @@ "title": "ana.base.invariant.unassume", "description": "How many times to unassume an invariant: once or until fixpoint (at least twice as expensive).", "type": "string", - "enum": [ - "once", - "fixpoint" - ], + "enum": ["once", "fixpoint"], "default": "once" }, "int": { @@ -899,11 +816,7 @@ "title": "ana.base.invariant.int.simplify", "description": "How much to simplify int domain invariants. Value \"int\" only simplifies definite integers. Without int domain refinement \"all\" might not be maximally precise.", "type": "string", - "enum": [ - "none", - "int", - "all" - ], + "enum": ["none", "int", "all"], "default": "all" } }, @@ -934,24 +847,20 @@ "properties": { "wrappers": { "title": "ana.malloc.wrappers", - "description": "Loads a list of known malloc wrapper functions.", + "description": + "Loads a list of known malloc wrapper functions.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [ - "kmalloc", - "__kmalloc", - "usb_alloc_urb", - "__builtin_alloca", + "kmalloc", "__kmalloc", "usb_alloc_urb", "__builtin_alloca", "kzalloc" ] }, "unique_address_count": { - "title": "ana.malloc.unique_address_count", - "description": "Number of unique memory addresses allocated for each malloc node.", - "type": "integer", - "default": 0 + "title": "ana.malloc.unique_address_count", + "description": "Number of unique memory addresses allocated for each malloc node.", + "type": "integer", + "default": 0 } }, "additionalProperties": false @@ -968,30 +877,25 @@ }, "domain": { "title": "ana.apron.domain", - "description": "Which domain should be used for the Apron analysis. Can be 'octagon', 'interval' or 'polyhedra'", + "description": + "Which domain should be used for the Apron analysis. Can be 'octagon', 'interval' or 'polyhedra'", "type": "string", - "enum": [ - "octagon", - "interval", - "polyhedra", - "affeq" - ], + "enum": ["octagon", "interval", "polyhedra", "affeq"], "default": "octagon" }, "threshold_widening": { "title": "ana.apron.threshold_widening", - "description": "Use constants appearing in program as threshold for widening", + "description": + "Use constants appearing in program as threshold for widening", "type": "boolean", "default": false }, "threshold_widening_constants": { "title": "ana.apron.threshold_widening_constants", - "description": "Which constants in the programm should be considered as threshold constants", + "description": + "Which constants in the programm should be considered as threshold constants", "type": "string", - "enum": [ - "all", - "comparisons" - ], + "enum": ["all", "comparisons"], "default": "all" }, "invariant": { @@ -1022,21 +926,10 @@ }, "privatization": { "title": "ana.relation.privatization", - "description": "Which relation privatization to use? top/protection/protection-path/mutex-meet/mutex-meet-tid/mutex-meet-tid-cluster12/mutex-meet-tid-cluster2/mutex-meet-tid-cluster-max/mutex-meet-tid-cluster-power", + "description": + "Which relation privatization to use? top/protection/protection-path/mutex-meet/mutex-meet-tid/mutex-meet-tid-cluster12/mutex-meet-tid-cluster2/mutex-meet-tid-cluster-max/mutex-meet-tid-cluster-power", "type": "string", - "enum": [ - "top", - "protection", - "protection-path", - "mutex-meet", - "mutex-meet-atomic", - "mutex-meet-tid", - "mutex-meet-tid-atomic", - "mutex-meet-tid-cluster12", - "mutex-meet-tid-cluster2", - "mutex-meet-tid-cluster-max", - "mutex-meet-tid-cluster-power" - ], + "enum": ["top", "protection", "protection-path", "mutex-meet", "mutex-meet-atomic", "mutex-meet-tid", "mutex-meet-tid-atomic", "mutex-meet-tid-cluster12", "mutex-meet-tid-cluster2", "mutex-meet-tid-cluster-max", "mutex-meet-tid-cluster-power"], "default": "mutex-meet" }, "priv": { @@ -1045,13 +938,15 @@ "properties": { "not-started": { "title": "ana.relation.priv.not-started", - "description": "Exclude writes from threads that may not be started yet", + "description": + "Exclude writes from threads that may not be started yet", "type": "boolean", "default": true }, "must-joined": { "title": "ana.relation.priv.must-joined", - "description": "Exclude writes from threads that must have been joined", + "description": + "Exclude writes from threads that must have been joined", "type": "boolean", "default": true } @@ -1092,7 +987,8 @@ "properties": { "widen": { "title": "ana.context.widen", - "description": "Do widening on contexts. Keeps a map of function to call state; enter will then return the widened local state for recursive calls.", + "description": + "Do widening on contexts. Keeps a map of function to call state; enter will then return the widened local state for recursive calls.", "type": "boolean", "default": false }, @@ -1117,27 +1013,25 @@ "properties": { "domain": { "title": "ana.thread.domain", - "description": "Which domain should be used for the thread ids. Can be 'history' or 'plain'", + "description": + "Which domain should be used for the thread ids. Can be 'history' or 'plain'", "type": "string", - "enum": [ - "history", - "plain" - ], + "enum": ["history", "plain"], "default": "history" }, - "include-node": { + "include-node" : { "title": "ana.thread.include-node", - "description": "Whether the node at which a thread is created is part of its threadid", + "description": + "Whether the node at which a thread is created is part of its threadid", "type": "boolean", - "default": true + "default" : true }, "wrappers": { "title": "ana.thread.wrappers", - "description": "Loads a list of known thread spawn (pthread_create) wrapper functions.", + "description": + "Loads a list of known thread spawn (pthread_create) wrapper functions.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "unique_thread_id_count": { @@ -1184,7 +1078,7 @@ "type": "boolean", "default": false }, - "volatile": { + "volatile" :{ "title": "ana.race.volatile", "description": "Report races for volatile variables.", "type": "boolean", @@ -1193,7 +1087,7 @@ }, "additionalProperties": false }, - "dead-code": { + "dead-code" : { "title": "ana.dead-code", "type": "object", "properties": { @@ -1218,7 +1112,7 @@ }, "additionalProperties": false }, - "extract-pthread": { + "extract-pthread" : { "title": "ana.extract-pthread", "type": "object", "properties": { @@ -1270,11 +1164,15 @@ ], "default": "partition" }, - "normal_form": { - "title": "ana.c2po.normal_form", - "description": "If true, the C-2PO Analysis computes a normal form of the domain, using minimal representatives of the equivalence classes, in order to check for equailty between two domain elements. If false, it compares the equivalence classes of the two domain elements.", - "type": "boolean", - "default": false + "equal": { + "title": "ana.c2po.equal", + "description": "Which equal algorithm 'c2po' should use. Values: 'partition' (default): it compares the partitions each time; 'normal_form': computes a normal form of the domain to compare them. It is lazily computed. The two possibilities are equivalent in precision, but in some cases computing the normal form is more efficient, as it is computed only once per distinct domain element.", + "type": "string", + "enum": [ + "normal_form", + "partition" + ], + "default": "partition" } }, "additionalProperties": false @@ -1302,7 +1200,8 @@ "properties": { "load": { "title": "incremental.load", - "description": "Load incremental analysis results, in case any exist.", + "description": + "Load incremental analysis results, in case any exist.", "type": "boolean", "default": false }, @@ -1314,7 +1213,8 @@ }, "only-rename": { "title": "incremental.only-rename", - "description": "Only reset IDs of unchanged objects in the AST. Do not reuse solver results. This option is mainly useful for benchmarking purposes.", + "description": + "Only reset IDs of unchanged objects in the AST. Do not reuse solver results. This option is mainly useful for benchmarking purposes.", "type": "boolean", "default": false }, @@ -1332,13 +1232,15 @@ }, "stable": { "title": "incremental.stable", - "description": "Reuse the stable set and selectively destabilize it (recommended).", + "description": + "Reuse the stable set and selectively destabilize it (recommended).", "type": "boolean", "default": true }, "wpoint": { "title": "incremental.wpoint", - "description": "Reuse the wpoint set (not recommended). Reusing the wpoint will combine existing results at previous widening points.", + "description": + "Reuse the wpoint set (not recommended). Reusing the wpoint will combine existing results at previous widening points.", "type": "boolean", "default": false }, @@ -1348,7 +1250,8 @@ "properties": { "enabled": { "title": "incremental.reluctant.enabled", - "description": "Destabilize nodes in changed functions reluctantly", + "description": + "Destabilize nodes in changed functions reluctantly", "type": "boolean", "default": false } @@ -1357,18 +1260,16 @@ }, "compare": { "title": "incremental.compare", - "description": "Which comparison should be used for functions? 'ast'/'cfg' (cfg comparison also differentiates which nodes of a function have changed)", + "description": + "Which comparison should be used for functions? 'ast'/'cfg' (cfg comparison also differentiates which nodes of a function have changed)", "type": "string", - "enum": [ - "ast", - "cfg" - ], + "enum": ["ast", "cfg"], "default": "ast" }, "detect-renames": { "title": "incremental.detect-renames", "description": "If Goblint should try to detect renamed local variables, function parameters, functions and global variables", - "type": "boolean", + "type":"boolean", "default": true }, "force-reanalyze": { @@ -1377,7 +1278,8 @@ "properties": { "funs": { "title": "incremental.force-reanalyze.funs", - "description": "List of functions that are to be re-analayzed from scratch", + "description": + "List of functions that are to be re-analayzed from scratch", "type": "array", "items": { "type": "string" @@ -1405,11 +1307,7 @@ "title": "incremental.restart.sided.vars", "description": "Side-effected variables to restart. Globals are non-function entry nodes. Write-only is a subset of globals.", "type": "string", - "enum": [ - "all", - "global", - "write-only" - ], + "enum": ["all", "global", "write-only"], "default": "all" }, "fuel": { @@ -1447,7 +1345,7 @@ }, "postsolver": { "title": "incremental.postsolver", - "type": "object", + "type" : "object", "properties": { "enabled": { "title": "incremental.postsolver.enabled", @@ -1455,8 +1353,8 @@ "type": "boolean", "default": true }, - "superstable-reached": { - "title": "incremental.postsolver.superstable-reached", + "superstable-reached" : { + "title": "incremental.postsolver.superstable-reached", "description": "Consider superstable set reached, may be faster but can lead to spurious warnings", "type": "boolean", "default": false @@ -1523,13 +1421,15 @@ "properties": { "spawn": { "title": "sem.unknown_function.spawn", - "description": "Unknown function call spawns reachable functions", + "description": + "Unknown function call spawns reachable functions", "type": "boolean", "default": true }, "call": { "title": "sem.unknown_function.call", - "description": "Unknown function call calls reachable functions", + "description": + "Unknown function call calls reachable functions", "type": "boolean", "default": true }, @@ -1539,13 +1439,15 @@ "properties": { "globals": { "title": "sem.unknown_function.invalidate.globals", - "description": "Unknown function call invalidates all globals", + "description": + "Unknown function call invalidates all globals", "type": "boolean", "default": true }, "args": { "title": "sem.unknown_function.invalidate.args", - "description": "Unknown function call invalidates arguments passed to it", + "description": + "Unknown function call invalidates arguments passed to it", "type": "boolean", "default": true } @@ -1558,7 +1460,8 @@ "properties": { "args": { "title": "sem.unknown_function.read.args", - "description": "Unknown function call reads arguments passed to it", + "description": + "Unknown function call reads arguments passed to it", "type": "boolean", "default": true } @@ -1574,7 +1477,8 @@ "properties": { "dead_code": { "title": "sem.builtin_unreachable.dead_code", - "description": "__builtin_unreachable is assumed to be dead code", + "description": + "__builtin_unreachable is assumed to be dead code", "type": "boolean", "default": false } @@ -1588,7 +1492,8 @@ "properties": { "dead_code": { "title": "sem.noreturn.dead_code", - "description": "For the purposes of detecting dead code, assume that functions marked noreturn don't return.", + "description": + "For the purposes of detecting dead code, assume that functions marked noreturn don't return.", "type": "boolean", "default": false } @@ -1601,13 +1506,10 @@ "properties": { "signed_overflow": { "title": "sem.int.signed_overflow", - "description": "How to handle overflows of signed types. Values: 'assume_top' (default): Assume signed overflow results in a top value; 'assume_none': Assume program is free of signed overflows; 'assume_wraparound': Assume signed types wrap-around and two's complement representation of signed integers", + "description": + "How to handle overflows of signed types. Values: 'assume_top' (default): Assume signed overflow results in a top value; 'assume_none': Assume program is free of signed overflows; 'assume_wraparound': Assume signed types wrap-around and two's complement representation of signed integers", "type": "string", - "enum": [ - "assume_top", - "assume_none", - "assume_wraparound" - ], + "enum": ["assume_top", "assume_none", "assume_wraparound"], "default": "assume_top" } }, @@ -1621,10 +1523,7 @@ "title": "sem.null-pointer.dereference", "description": "NULL pointer dereference handling. assume_top: assume it results in a top value, assume_none: assume it doesn't happen", "type": "string", - "enum": [ - "assume_top", - "assume_none" - ], + "enum": ["assume_top", "assume_none"], "default": "assume_none" } }, @@ -1636,7 +1535,8 @@ "properties": { "fail": { "title": "sem.malloc.fail", - "description": "Consider the case where malloc or calloc fails.", + "description": + "Consider the case where malloc or calloc fails.", "type": "boolean", "default": false } @@ -1649,7 +1549,8 @@ "properties": { "fail": { "title": "sem.lock.fail", - "description": "Takes the possible failing of locking operations into account.", + "description": + "Takes the possible failing of locking operations into account.", "type": "boolean", "default": false } @@ -1679,16 +1580,12 @@ "properties": { "activated": { "title": "trans.activated", - "description": "Lists of activated transformations. Transformations happen after analyses.", + "description": + "Lists of activated transformations. Transformations happen after analyses.", "type": "array", "items": { "type": "string", - "enum": [ - "partial", - "expeval", - "assert", - "remove_dead_code" - ] + "enum": ["partial", "expeval", "assert", "remove_dead_code"] }, "default": [] }, @@ -1698,20 +1595,21 @@ "properties": { "query_file_name": { "title": "trans.expeval.query_file_name", - "description": "Path to the JSON file containing an expression evaluation query.", + "description": + "Path to the JSON file containing an expression evaluation query.", "type": "string", "default": "" } }, "additionalProperties": false }, - "output": { + "output" : { "title": "trans.output", "description": "Output filename for transformations that output a transformed file.", - "type": "string", + "type":"string", "default": "transformed.c" }, - "assert": { + "assert" : { "title": "trans.assert", "type": "object", "properties": { @@ -1719,11 +1617,7 @@ "title": "trans.assert.function", "description": "Function to use for assertions in output.", "type": "string", - "enum": [ - "assert", - "__goblint_check", - "__VERIFIER_assert" - ], + "enum": ["assert", "__goblint_check", "__VERIFIER_assert"], "default": "__VERIFIER_assert" }, "wrap-atomic": { @@ -1749,13 +1643,15 @@ "properties": { "enabled": { "title": "annotation.int.enabled", - "description": "Enable manual annotation of functions with desired precision, i.e., the activated IntDomains.", + "description": + "Enable manual annotation of functions with desired precision, i.e., the activated IntDomains.", "type": "boolean", "default": false }, "privglobs": { "title": "annotation.int.privglobs", - "description": "Enables handling of privatized globals, by setting the precision to the heighest value, when annotation.int.enabled is true.", + "description": + "Enables handling of privatized globals, by setting the precision to the heighest value, when annotation.int.enabled is true.", "type": "boolean", "default": true } @@ -1768,7 +1664,8 @@ "properties": { "enabled": { "title": "annotation.float.enabled", - "description": "Enable manual annotation of functions with desired precision, i.e., the activated FloatDomains.", + "description": + "Enable manual annotation of functions with desired precision, i.e., the activated FloatDomains.", "type": "boolean", "default": false } @@ -1782,20 +1679,7 @@ "type": "array", "items": { "type": "string", - "enum": [ - "base.no-non-ptr", - "base.non-ptr", - "base.no-int", - "base.int", - "base.no-interval", - "base.no-interval_set", - "base.interval", - "base.interval_set", - "relation.no-context", - "relation.context", - "no-widen", - "widen" - ] + "enum": ["base.no-non-ptr", "base.non-ptr", "base.no-int", "base.int", "base.no-interval", "base.no-interval_set","base.interval", "base.interval_set","relation.no-context", "relation.context", "no-widen", "widen"] }, "default": [] } @@ -1807,16 +1691,7 @@ "type": "array", "items": { "type": "string", - "enum": [ - "no-def_exc", - "def_exc", - "no-interval", - "interval", - "no-enums", - "enums", - "no-congruence", - "congruence" - ] + "enum": ["no-def_exc", "def_exc", "no-interval", "interval", "no-enums", "enums", "no-congruence", "congruence"] }, "default": [] } @@ -1849,7 +1724,8 @@ }, "priv-distr-init": { "title": "exp.priv-distr-init", - "description": "Distribute global initializations to all global invariants for more consistent widening dynamics.", + "description": + "Distribute global initializations to all global invariants for more consistent widening dynamics.", "type": "boolean", "default": false }, @@ -1880,7 +1756,8 @@ }, "earlyglobs": { "title": "exp.earlyglobs", - "description": "Side-effecting of globals right after initialization.", + "description": + "Side-effecting of globals right after initialization.", "type": "boolean", "default": false }, @@ -1894,20 +1771,20 @@ "title": "exp.unique", "description": "For types that have only one value.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "forward": { "title": "exp.forward", - "description": "Use implicit forward propagation instead of the demand driven approach.", + "description": + "Use implicit forward propagation instead of the demand driven approach.", "type": "boolean", "default": false }, "volatiles_are_top": { "title": "exp.volatiles_are_top", - "description": "volatile and extern keywords set variables permanently to top", + "description": + "volatile and extern keywords set variables permanently to top", "type": "boolean", "default": true }, @@ -1925,20 +1802,18 @@ }, "exclude_from_earlyglobs": { "title": "exp.exclude_from_earlyglobs", - "description": "Global variables that should be handled flow-sensitively when using earlyglobs.", + "description": + "Global variables that should be handled flow-sensitively when using earlyglobs.", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, - "exclude_from_invalidation": { + "exclude_from_invalidation" : { "title": "exp.exclude_from_invalidation", - "description": "Global variables that should not be invalidated. This assures the analysis that such globals are only modified through known code", + "description": + "Global variables that should not be invalidated. This assures the analysis that such globals are only modified through known code", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "g2html_path": { @@ -1949,11 +1824,10 @@ }, "extraspecials": { "title": "exp.extraspecials", - "description": "List of functions that must be analyzed as unknown extern functions", + "description": + "List of functions that must be analyzed as unknown extern functions", "type": "array", - "items": { - "type": "string" - }, + "items": { "type": "string" }, "default": [] }, "no-narrow": { @@ -1964,13 +1838,15 @@ }, "basic-blocks": { "title": "exp.basic-blocks", - "description": "Only keep values for basic blocks instead of for every node. Should take longer but need less space.", + "description": + "Only keep values for basic blocks instead of for every node. Should take longer but need less space.", "type": "boolean", "default": false }, "fast_global_inits": { "title": "exp.fast_global_inits", - "description": "Only generate one 'a[any_index] = x' for all assignments a[...] = x for a global array a[n].", + "description": + "Only generate one 'a[any_index] = x' for all assignments a[...] = x for a global array a[n].", "type": "boolean", "default": true }, @@ -1978,27 +1854,27 @@ "title": "exp.architecture", "description": "Architecture for analysis, currently for witness", "type": "string", - "enum": [ - "64bit", - "32bit" - ], + "enum": ["64bit", "32bit"], "default": "64bit" }, "gcc_path": { "title": "exp.gcc_path", - "description": "Location of gcc. Used to combine source files with cilly. Change to gcc-9 or another version on OS X (with gcc being clang by default cilly will fail otherwise).", + "description": + "Location of gcc. Used to combine source files with cilly. Change to gcc-9 or another version on OS X (with gcc being clang by default cilly will fail otherwise).", "type": "string", "default": "/usr/bin/gcc" }, "cpp-path": { "title": "exp.cpp-path", - "description": "Path to C preprocessor (cpp) to use. If empty, then automatically searched.", + "description": + "Path to C preprocessor (cpp) to use. If empty, then automatically searched.", "type": "string", "default": "" }, "unrolling-factor": { "title": "exp.unrolling-factor", - "description": "Sets the unrolling factor for the loopUnrollingVisitor.", + "description": + "Sets the unrolling factor for the loopUnrollingVisitor.", "type": "integer", "default": 0 }, @@ -2034,10 +1910,7 @@ "title": "exp.arg.dot.node-label", "description": "Which ARG node labels to use? node/empty", "type": "string", - "enum": [ - "node", - "empty" - ], + "enum": ["node", "empty"], "default": "node" } }, @@ -2058,13 +1931,7 @@ "title": "dbg.level", "description": "Logging level.", "type": "string", - "enum": [ - "debug", - "info", - "warning", - "error", - "result" - ], + "enum": ["debug", "info", "warning", "error", "result"], "default": "info" }, "timing": { @@ -2115,45 +1982,48 @@ "title": "dbg.justcil-printer", "description": "Printer to use for justcil: default, or clean (excludes line directives and builtin declarations).", "type": "string", - "enum": [ - "default", - "clean" - ], + "enum": ["default", "clean"], "default": "default" }, "timeout": { "title": "dbg.timeout", - "description": "Stop solver after this time. 0 means no timeout. Supports optional units h, m, s. E.g. 1m6s = 01m06s = 66; 6h = 6*60*60.", + "description": + "Stop solver after this time. 0 means no timeout. Supports optional units h, m, s. E.g. 1m6s = 01m06s = 66; 6h = 6*60*60.", "type": "string", "default": "0" }, "solver-stats-interval": { "title": "dbg.solver-stats-interval", - "description": "Interval in seconds to print statistics while solving. Set to 0 to deactivate.", + "description": + "Interval in seconds to print statistics while solving. Set to 0 to deactivate.", "type": "integer", "default": 10 }, "solver-signal": { "title": "dbg.solver-signal", - "description": "Signal to print statistics while solving. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", + "description": + "Signal to print statistics while solving. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", "type": "string", "default": "sigusr1" }, "backtrace-signal": { "title": "dbg.backtrace-signal", - "description": "Signal to print a raw backtrace on stderr. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", + "description": + "Signal to print a raw backtrace on stderr. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", "type": "string", "default": "sigusr2" }, "solver-progress": { "title": "dbg.solver-progress", - "description": "Used for debugging. Prints out a symbol on solving a rhs.", + "description": + "Used for debugging. Prints out a symbol on solving a rhs.", "type": "boolean", "default": false }, "print_wpoints": { "title": "dbg.print_wpoints", - "description": "Print the widening points after solving (does not include the removed wpoints during solving by the slr solvers). Currently only implemented in: slr*, td3.", + "description": + "Print the widening points after solving (does not include the removed wpoints during solving by the slr solvers). Currently only implemented in: slr*, td3.", "type": "boolean", "default": false }, @@ -2182,7 +2052,8 @@ "properties": { "widen": { "title": "dbg.limit.widen", - "description": "Limit for number of widenings per node (0 = no limit).", + "description": + "Limit for number of widenings per node (0 = no limit).", "type": "integer", "default": 0 } @@ -2191,13 +2062,15 @@ }, "warn_with_context": { "title": "dbg.warn_with_context", - "description": "Keep warnings for different contexts apart (currently only done for asserts).", + "description": + "Keep warnings for different contexts apart (currently only done for asserts).", "type": "boolean", "default": false }, "regression": { "title": "dbg.regression", - "description": "Only output warnings for assertions that have an unexpected result (no comment, comment FAIL, comment UNKNOWN)", + "description": + "Only output warnings for assertions that have an unexpected result (no comment, comment FAIL, comment UNKNOWN)", "type": "boolean", "default": false }, @@ -2278,19 +2151,22 @@ }, "print_tids": { "title": "dbg.print_tids", - "description": "Should the analysis print information on the encountered TIDs", + "description": + "Should the analysis print information on the encountered TIDs", "type": "boolean", "default": false }, "print_protection": { "title": "dbg.print_protection", - "description": "Should the analysis print information on which globals are protected by which mutex?", + "description": + "Should the analysis print information on which globals are protected by which mutex?", "type": "boolean", "default": false }, - "run_cil_check": { + "run_cil_check" : { "title": "dbg.run_cil_check", - "description": "Should the analysis call Check.checkFile after creating the CFG (helpful to verify that transformations respect CIL's invariants.", + "description": + "Should the analysis call Check.checkFile after creating the CFG (helpful to verify that transformations respect CIL's invariants.", "type": "boolean", "default": false }, @@ -2454,7 +2330,7 @@ }, "memleak": { "title": "warn.memleak", - "type": "object", + "type":"object", "properties": { "memcleanup": { "title": "warn.memleak.memcleanup", @@ -2484,29 +2360,23 @@ "properties": { "term": { "title": "solvers.td3.term", - "description": "Should the td3 solver use the phased/terminating strategy?", + "description": + "Should the td3 solver use the phased/terminating strategy?", "type": "boolean", "default": true }, "side_widen": { "title": "solvers.td3.side_widen", - "description": "When to widen in side. never: never widen, always: always widen, sides: widen if there are multiple side-effects from the same var resulting in a new value, cycle: widen if a called or a start var get destabilized, unstable_called: widen if any called var gets destabilized, unstable_self: widen if side-effected var gets destabilized, sides-pp: widen if there are multiple side-effects from the same program point resulting in a new value, sides-local: Widen with contributions from variables from which multiple side-effects leading to a new value originate.", + "description": + "When to widen in side. never: never widen, always: always widen, sides: widen if there are multiple side-effects from the same var resulting in a new value, cycle: widen if a called or a start var get destabilized, unstable_called: widen if any called var gets destabilized, unstable_self: widen if side-effected var gets destabilized, sides-pp: widen if there are multiple side-effects from the same program point resulting in a new value, sides-local: Widen with contributions from variables from which multiple side-effects leading to a new value originate.", "type": "string", - "enum": [ - "never", - "always", - "sides", - "cycle", - "unstable_called", - "unstable_self", - "sides-pp", - "sides-local" - ], + "enum": ["never", "always", "sides", "cycle", "unstable_called", "unstable_self", "sides-pp","sides-local"], "default": "sides" }, "space": { "title": "solvers.td3.space", - "description": "Should the td3 solver only keep values at widening points?", + "description": + "Should the td3 solver only keep values at widening points?", "type": "boolean", "default": false }, @@ -2518,7 +2388,8 @@ }, "space_restore": { "title": "solvers.td3.space_restore", - "description": "Should the td3-space solver restore values for non-widening-points? Not needed for generating warnings, but needed for inspecting output!", + "description": + "Should the td3-space solver restore values for non-widening-points? Not needed for generating warnings, but needed for inspecting output!", "type": "boolean", "default": true }, @@ -2534,10 +2405,10 @@ "type": "boolean", "default": true }, - "skip-unchanged-rhs": { - "title": "solvers.td3.skip-unchanged-rhs", - "description": "Skip evaluation of RHS if all dependencies are unchanged - INCOMPATIBLE WITH RESTARTING", - "type": "boolean", + "skip-unchanged-rhs" : { + "title" : "solvers.td3.skip-unchanged-rhs", + "description" : "Skip evaluation of RHS if all dependencies are unchanged - INCOMPATIBLE WITH RESTARTING", + "type" : "boolean", "default": false }, "restart": { @@ -2581,7 +2452,8 @@ "properties": { "restart_count": { "title": "solvers.slr4.restart_count", - "description": "How many times SLR4 is allowed to switch from restarting iteration to increasing iteration.", + "description": + "How many times SLR4 is allowed to switch from restarting iteration to increasing iteration.", "type": "integer", "default": 1 } @@ -2615,10 +2487,7 @@ "title": "witness.graphml.id", "description": "Which witness node IDs to use? node/enumerate", "type": "string", - "enum": [ - "node", - "enumerate" - ], + "enum": ["node", "enumerate"], "default": "node" }, "minimize": { @@ -2629,7 +2498,8 @@ }, "uncil": { "title": "witness.graphml.uncil", - "description": "Try to undo CIL control flow transformations in witness", + "description": + "Try to undo CIL control flow transformations in witness", "type": "boolean", "default": false }, @@ -2654,19 +2524,22 @@ "properties": { "loop-head": { "title": "witness.invariant.loop-head", - "description": "Emit invariants at loop heads", + "description": + "Emit invariants at loop heads", "type": "boolean", "default": true }, "after-lock": { "title": "witness.invariant.after-lock", - "description": "Emit invariants after mutex locking", + "description": + "Emit invariants after mutex locking", "type": "boolean", "default": true }, "other": { "title": "witness.invariant.other", - "description": "Emit invariants at all other locations", + "description": + "Emit invariants at all other locations", "type": "boolean", "default": true }, @@ -2684,7 +2557,8 @@ }, "full": { "title": "witness.invariant.full", - "description": "Whether to dump assertions about all local variables or limitting it to modified ones where possible.", + "description": + "Whether to dump assertions about all local variables or limitting it to modified ones where possible.", "type": "boolean", "default": true }, From 39b22610eece0b75cde0b21a66548d1a300347b4 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 12:54:15 +0200 Subject: [PATCH 321/323] fix bug --- src/cdomains/c2poDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index 2b5382c42f..ad486a2f73 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -43,7 +43,7 @@ module C2PODomain = struct let equal a b = if M.tracing then M.trace "c2po-normal-form" "COMPUTING EQUAL"; - match GobConfig.get_string "ana.c2po.normal_form" with + match GobConfig.get_string "ana.c2po.equal" with | "normal_form" -> equal_normal_form a b | _ -> equal_standard a b From c9a7e044294147764a58156fd029b7c519d22b07 Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Tue, 10 Sep 2024 13:01:33 +0200 Subject: [PATCH 322/323] change the location od c2poAnalysis in Goblint_lib --- src/goblint_lib.ml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index cedfc55979..592c184c14 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -81,6 +81,7 @@ module LinearTwoVarEqualityAnalysis = LinearTwoVarEqualityAnalysis module VarEq = VarEq module CondVars = CondVars module TmpSpecial = TmpSpecial +module C2poAnalysis = C2poAnalysis (** {2 Heap} @@ -92,7 +93,6 @@ module Malloc_null = Malloc_null module MemLeak = MemLeak module UseAfterFree = UseAfterFree module MemOutOfBounds = MemOutOfBounds -module C2poAnalysis = C2poAnalysis (** {2 Concurrency} @@ -249,6 +249,13 @@ module ApronDomain = ApronDomain module AffineEqualityDomain = AffineEqualityDomain module LinearTwoVarEqualityDomain = LinearTwoVarEqualityDomain +(** {5 2-Pointer Logic} + + Domains for {!C2poAnalysis}. *) +module CongruenceClosure = CongruenceClosure +module UnionFind = UnionFind +module C2poDomain = C2poDomain + (** {3 Concurrency} *) module MutexAttrDomain = MutexAttrDomain @@ -275,10 +282,6 @@ module MusteqDomain = MusteqDomain module RegionDomain = RegionDomain module StackDomain = StackDomain -module CongruenceClosure = CongruenceClosure -module UnionFind = UnionFind -module C2poDomain = C2poDomain - (** {2 Testing} Modules related to (property-based) testing of domains. *) From cb9dc2feafbf3e600e5bb1787ed97d9e448746da Mon Sep 17 00:00:00 2001 From: Rebecca Ghidini Date: Wed, 11 Sep 2024 14:02:37 +0200 Subject: [PATCH 323/323] modify richvarinfo to make it possible to change all the other fields of the resulting varinfo --- src/analyses/c2poAnalysis.ml | 5 +- src/analyses/wrapperFunctionAnalysis.ml | 2 + src/cdomains/c2poDomain.ml | 15 +++-- src/cdomains/duplicateVars.ml | 41 ++++++++----- src/common/util/richVarinfo.ml | 79 ++++++++++++++++++++++--- src/common/util/richVarinfo.mli | 25 +++++++- 6 files changed, 133 insertions(+), 34 deletions(-) diff --git a/src/analyses/c2poAnalysis.ml b/src/analyses/c2poAnalysis.ml index a886b6f8ed..aab439e024 100644 --- a/src/analyses/c2poAnalysis.ml +++ b/src/analyses/c2poAnalysis.ml @@ -73,7 +73,7 @@ struct t |> meet_conjs_opt [Equal (dummy_var, term, offset)] |> D.remove_may_equal_terms ask s lterm |> meet_conjs_opt [Equal (lterm, dummy_var, Z.zero)] |> - D.remove_terms_containing_variable @@ AssignAux lval_t + D.remove_terms_containing_aux_variable | _ -> (* this is impossible *) C2PODomain.top () (** Assign Cil Lval to a right hand side that is already converted to @@ -188,7 +188,8 @@ struct let remove_out_of_scope_vars t f = let local_vars = f.sformals @ f.slocals in let duplicated_vars = f.sformals in - D.remove_terms_containing_variables (ReturnAux (TVoid [])::Var.from_varinfo local_vars duplicated_vars) t + let t = D.remove_terms_containing_return_variable t in + D.remove_terms_containing_variables (Var.from_varinfo local_vars duplicated_vars) t let combine_env ctx var_opt expr f args t_context_opt t (ask: Queries.ask) = match ctx.local with diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index eb9ec6ce02..94f1dbda86 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -144,6 +144,8 @@ module MallocWrapper : MCPSpec = struct Format.dprintf "@tid:%s" (ThreadLifted.show t) in Format.asprintf "(alloc@sid:%s%t%t)" (Node.show_id node) tid uniq_count + + let varinfo_attributes x = RichVarinfo.VarinfoDescription.empty (name_varinfo x) end module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(ThreadNode) diff --git a/src/cdomains/c2poDomain.ml b/src/cdomains/c2poDomain.ml index ad486a2f73..0d5f5063c2 100644 --- a/src/cdomains/c2poDomain.ml +++ b/src/cdomains/c2poDomain.ml @@ -156,11 +156,18 @@ module D = struct | `Bot -> BatPrintf.fprintf f "\nbottom\n\n" (** Remove terms from the data structure. - It removes all terms for which "var" is a subterm, + It removes all terms that contain an AssignAux variable, while maintaining all equalities about variables that are not being removed.*) - let remove_terms_containing_variable var cc = - if M.tracing then M.trace "c2po" "remove_terms_containing_variable: %s\n" (T.show (Addr var)); - remove_terms (fun t -> Var.equal (T.get_var t) var) cc + let remove_terms_containing_aux_variable cc = + if M.tracing then M.trace "c2po" "remove_terms_containing_aux_variable\n"; + remove_terms (fun t -> Var.is_assign_aux (T.get_var t)) cc + + (** Remove terms from the data structure. + It removes all terms that contain an ReturnAux variable, + while maintaining all equalities about variables that are not being removed.*) + let remove_terms_containing_return_variable cc = + if M.tracing then M.trace "c2po" "remove_terms_containing_aux_variable\n"; + remove_terms (fun t -> Var.is_return_aux (T.get_var t)) cc (** Remove terms from the data structure. It removes all terms which contain one of the "vars", diff --git a/src/cdomains/duplicateVars.ml b/src/cdomains/duplicateVars.ml index a70f98634c..492e8f9bf3 100644 --- a/src/cdomains/duplicateVars.ml +++ b/src/cdomains/duplicateVars.ml @@ -6,6 +6,7 @@ open CilType open GoblintCil open Batteries open GoblintCil +module M = Messages (** Variable Type used by the C-2PO Analysis. It contains normal variables with a varinfo as well as auxiliary variables for @@ -13,12 +14,12 @@ open GoblintCil module VarType = struct (* the hash/compare values should not depend on the type. But they have to be defined even though they are not used, for some reason.*) - let equal_typ _ _ = true - let hash_typ _ = 0 - let compare_typ _ _ = 0 + let equal_typ a b = Stdlib.compare a b = 0 + let hash_typ x = Hashtbl.hash x + let compare_typ a b = Stdlib.compare a b - type t = AssignAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) - | ReturnAux of (typ[@compare.ignore][@eq.ignore][@hash.ignore]) + type t = AssignAux of typ + | ReturnAux of typ | NormalVar of Varinfo.t | DuplicVar of Varinfo.t [@@deriving eq,ord,hash] @@ -31,11 +32,20 @@ module VarType = struct | NormalVar v -> v.vname | DuplicVar v -> "c2po__" ^ v.vname ^ "'" - let name_varinfo v = match v with - | AssignAux t -> "AuxAssign" - | ReturnAux t -> "AuxReturn" - | NormalVar v -> string_of_int v.vid - | DuplicVar v -> "c2po__" ^ string_of_int v.vid ^ "'" + let get_type v = match v with + | AssignAux t | ReturnAux t -> t + | NormalVar v | DuplicVar v -> v.vtype + + let is_assign_aux = function | AssignAux _ -> true | _ -> false + let is_return_aux = function | ReturnAux _ -> true | _ -> false + + let varinfo_attributes v = + let open RichVarinfo.VarinfoDescription in + match v with + | AssignAux t -> ({(empty "AuxAssign") with vtype_=Some t}) + | ReturnAux t -> ({(empty "AuxReturn") with vtype_=Some t}) + | NormalVar v -> from_varinfo v + | DuplicVar v -> ({(from_varinfo v) with vname_="c2po__" ^ string_of_int v.vid ^ "'"}) (* Description that gets appended to the varinfo-name in user output. *) let describe_varinfo (var: varinfo) v = @@ -49,11 +59,10 @@ struct include VarType let dummy_varinfo typ: varinfo = VarVarinfoMap.to_varinfo (AssignAux typ) let return_varinfo typ = VarVarinfoMap.to_varinfo (ReturnAux typ) - let to_varinfo v = let var = VarVarinfoMap.to_varinfo v in - match v with - | AssignAux t -> {var with vtype = t} - | ReturnAux t -> {var with vtype = t} - | NormalVar v -> v - | DuplicVar v -> {v with vid = var.vid} + let to_varinfo v = + let res = VarVarinfoMap.to_varinfo v in + if M.tracing then M.trace "c2po-varinfo" "to_varinfo: %a -> %a" d_type (get_type v) d_type res.vtype; + res + end diff --git a/src/common/util/richVarinfo.ml b/src/common/util/richVarinfo.ml index d1918c40a6..78e6f576e1 100644 --- a/src/common/util/richVarinfo.ml +++ b/src/common/util/richVarinfo.ml @@ -1,12 +1,5 @@ open GoblintCil -let create_var name = Cilfacade.create_var @@ makeGlobalVar name voidType - -let single ~name = - let vi = lazy (create_var name) in - fun () -> - Lazy.force vi - module type VarinfoMap = sig type t @@ -17,10 +10,78 @@ sig val bindings: unit -> (t * varinfo) list end +module VarinfoDescription = struct + (**This type is equal to `varinfo`, but the fields are not mutable and they are optional. + Only the name is not optional. *) + type t = { + vname_: string; + vtype_: typ option; + vattr_: attributes option; + vstorage_: storage option; + vglob_: bool option; + vinline_: bool option; + vdecl_: location option; + vinit_: initinfo option; + vaddrof_: bool option; + vreferenced_: bool option; + } + + let from_varinfo (v: varinfo) = + {vname_=v.vname; + vtype_=Some v.vtype; + vattr_=Some v.vattr; + vstorage_=Some v.vstorage; + vglob_=Some v.vglob; + vinline_=Some v.vinline; + vdecl_=Some v.vdecl; + vinit_=Some v.vinit; + vaddrof_=Some v.vaddrof; + vreferenced_=Some v.vreferenced} + + let empty name = + {vname_=name; + vtype_=None; + vattr_=None; + vstorage_=None; + vglob_=None; + vinline_=None; + vdecl_=None; + vinit_=None; + vaddrof_=None; + vreferenced_=None} + + let update_varinfo (v: varinfo) (update: t) = + let open Batteries in + {vname=update.vname_; + vtype=Option.default v.vtype update.vtype_; + vattr=Option.default v.vattr update.vattr_; + vstorage=Option.default v.vstorage update.vstorage_; + vglob=Option.default v.vglob update.vglob_; + vinline=Option.default v.vinline update.vinline_; + vdecl=Option.default v.vdecl update.vdecl_; + vinit=Option.default v.vinit update.vinit_; + vid=v.vid; + vaddrof=Option.default v.vaddrof update.vaddrof_; + vreferenced=Option.default v.vreferenced update.vreferenced_; + vdescr=v.vdescr; + vdescrpure=v.vdescrpure; + vhasdeclinstruction=v.vhasdeclinstruction} +end + +let create_var (vd: VarinfoDescription.t) = + Cilfacade.create_var ( + VarinfoDescription.update_varinfo (makeGlobalVar vd.vname_ voidType) vd + ) + +let single ~name = + let vi = lazy (create_var (VarinfoDescription.empty name)) in + fun () -> + Lazy.force vi + module type G = sig include Hashtbl.HashedType - val name_varinfo: t -> string + val varinfo_attributes: t -> VarinfoDescription.t end module type H = @@ -47,7 +108,7 @@ struct try XH.find !xh x with Not_found -> - let vi = create_var (X.name_varinfo x) in + let vi = create_var (X.varinfo_attributes x) in store_f x vi; vi diff --git a/src/common/util/richVarinfo.mli b/src/common/util/richVarinfo.mli index 4e682734ee..7847eccd85 100644 --- a/src/common/util/richVarinfo.mli +++ b/src/common/util/richVarinfo.mli @@ -2,8 +2,6 @@ open GoblintCil -val single: name:string -> (unit -> varinfo) - module type VarinfoMap = sig type t @@ -14,10 +12,31 @@ sig val bindings: unit -> (t * varinfo) list end +module VarinfoDescription: +sig + type t = { + vname_: string; + vtype_: typ option; + vattr_: attributes option; + vstorage_: storage option; + vglob_: bool option; + vinline_: bool option; + vdecl_: location option; + vinit_: initinfo option; + vaddrof_: bool option; + vreferenced_: bool option; + } + val from_varinfo: varinfo -> t + val empty: string -> t + val update_varinfo: varinfo -> t -> varinfo +end + +val single: name:string -> (unit -> varinfo) + module type G = sig include Hashtbl.HashedType - val name_varinfo: t -> string + val varinfo_attributes: t -> VarinfoDescription.t end module type H =